diff options
Diffstat (limited to 'src/eval.c')
| -rw-r--r-- | src/eval.c | 43 |
1 files changed, 30 insertions, 13 deletions
diff --git a/src/eval.c b/src/eval.c index 2dd0c356e88..cd3eb0a3676 100644 --- a/src/eval.c +++ b/src/eval.c @@ -571,11 +571,12 @@ omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE, or of the variable at the end of the chain of aliases, if BASE-VARIABLE is itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not, then the value of BASE-VARIABLE is set to that of NEW-ALIAS. -The return value is BASE-VARIABLE. */) +The return value is BASE-VARIABLE. + +If the resulting chain of variable definitions would contain a loop, +signal a `cyclic-variable-indirection' error. */) (Lisp_Object new_alias, Lisp_Object base_variable, Lisp_Object docstring) { - struct Lisp_Symbol *sym; - CHECK_SYMBOL (new_alias); CHECK_SYMBOL (base_variable); @@ -584,7 +585,18 @@ The return value is BASE-VARIABLE. */) error ("Cannot make a constant an alias: %s", SDATA (SYMBOL_NAME (new_alias))); - sym = XSYMBOL (new_alias); + struct Lisp_Symbol *sym = XSYMBOL (new_alias); + + /* Ensure non-circularity. */ + struct Lisp_Symbol *s = XSYMBOL (base_variable); + for (;;) + { + if (s == sym) + xsignal1 (Qcyclic_variable_indirection, base_variable); + if (s->u.s.redirect != SYMBOL_VARALIAS) + break; + s = SYMBOL_ALIAS (s); + } switch (sym->u.s.redirect) { @@ -1367,7 +1379,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, error ("Invalid condition handler: %s", SDATA (Fprin1_to_string (tem, Qt, Qnil))); if (CONSP (tem) && EQ (XCAR (tem), QCsuccess)) - success_handler = XCDR (tem); + success_handler = tem; else clausenb++; } @@ -1430,7 +1442,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, if (!NILP (success_handler)) { if (NILP (var)) - return Fprogn (success_handler); + return Fprogn (XCDR (success_handler)); Lisp_Object handler_var = var; if (!NILP (Vinternal_interpreter_environment)) @@ -1442,7 +1454,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, specpdl_ref count = SPECPDL_INDEX (); specbind (handler_var, result); - return unbind_to (count, Fprogn (success_handler)); + return unbind_to (count, Fprogn (XCDR (success_handler))); } return result; } @@ -2116,7 +2128,7 @@ then strings and vectors are not accepted. */) fun = function; - fun = indirect_function (fun); /* Check cycles. */ + fun = indirect_function (fun); if (NILP (fun)) return Qnil; @@ -2348,6 +2360,8 @@ it defines a macro. */) } +static Lisp_Object list_of_t; /* Never-modified constant containing (t). */ + DEFUN ("eval", Feval, Seval, 1, 2, 0, doc: /* Evaluate FORM and return its value. If LEXICAL is t, evaluate using lexical scoping. @@ -2357,7 +2371,7 @@ alist mapping symbols to their value. */) { specpdl_ref count = SPECPDL_INDEX (); specbind (Qinternal_interpreter_environment, - CONSP (lexical) || NILP (lexical) ? lexical : list1 (Qt)); + CONSP (lexical) || NILP (lexical) ? lexical : list_of_t); return unbind_to (count, eval_sub (form)); } @@ -2371,8 +2385,7 @@ grow_specpdl_allocation (void) union specbinding *pdlvec = specpdl - 1; ptrdiff_t size = specpdl_end - specpdl; ptrdiff_t pdlvecsize = size + 1; - if (max_size <= size) - xsignal0 (Qexcessive_variable_binding); /* Can't happen, essentially. */ + eassert (max_size > size); pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); specpdl = pdlvec + 1; specpdl_end = specpdl + pdlvecsize - 1; @@ -3398,7 +3411,7 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, return object; } -/* Return true if SYMBOL currently has a let-binding +/* Return true if SYMBOL's default currently has a let-binding which was made in the buffer that is now current. */ bool @@ -3413,6 +3426,7 @@ let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol) struct Lisp_Symbol *let_bound_symbol = XSYMBOL (specpdl_symbol (p)); eassert (let_bound_symbol->u.s.redirect != SYMBOL_VARALIAS); if (symbol == let_bound_symbol + && p->kind != SPECPDL_LET_LOCAL /* bug#62419 */ && EQ (specpdl_where (p), buf)) return 1; } @@ -3474,7 +3488,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: - sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start; + sym = SYMBOL_ALIAS (sym); XSETSYMBOL (symbol, sym); goto start; case SYMBOL_PLAINVAL: /* The most common case is that of a non-constant symbol with a trivial value. Make that as fast as we can. */ @@ -4392,6 +4406,9 @@ alist of active lexical bindings. */); Qcatch_all_memory_full = Fmake_symbol (build_pure_c_string ("catch-all-memory-full")); + staticpro (&list_of_t); + list_of_t = list1 (Qt); + defsubr (&Sor); defsubr (&Sand); defsubr (&Sif); |