summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorMattias EngdegÄrd <mattiase@acm.org>2023-04-14 18:26:27 +0200
committerMattias EngdegÄrd <mattiase@acm.org>2023-04-14 19:34:23 +0200
commitc60b59e04c3776a90adaa8c8fe53af3075a833b8 (patch)
tree55b5586eee1749ef451982b5edcf4f65666d0b9c /src
parentdc842a71ed035dab1115f2e67d35dd07410e18be (diff)
downloademacs-c60b59e04c3776a90adaa8c8fe53af3075a833b8.tar.gz
Disallow creation of circular variable alias chains
Make `defvaralias` signal an error upon attempts to create variable alias cycles. This detects errors earlier and makes the alias traversal during execution simpler and faster since no cycle detection is needed elsewhere. Now variable and function aliases are handled identically in these respects. * src/lisp.h (indirect_variable): Remove declaration. * src/data.c (indirect_variable): Remove. (Findirect_variable): Update doc string. Simplify alias resolution. (Fboundp, find_symbol_value, set_internal, default_value) (set_default_internal, Fmake_variable_buffer_local) (Fmake_local_variable, Fkill_local_variable, Flocal_variable_p) (Flocal_variable_if_set_p, Fvariable_binding_locus): * src/buffer.c (buffer_local_value): * src/eval.c (specbind): Simplify variable alias resolution. (Fdefvaralias): Update doc string. Check for cycles. * doc/lispref/variables.texi (Variable Aliases): Mention that `defvaralias` can signal `cyclic-variable-indirection` but `indirect-variable` cannot. * etc/NEWS: Announce the change. * test/src/eval-tests.el (eval-tests-defvaralias): New test.
Diffstat (limited to 'src')
-rw-r--r--src/buffer.c2
-rw-r--r--src/data.c61
-rw-r--r--src/eval.c22
-rw-r--r--src/lisp.h1
4 files changed, 33 insertions, 53 deletions
diff --git a/src/buffer.c b/src/buffer.c
index 31c08cf3650..3e3be805a6d 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -1307,7 +1307,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer)
start:
switch (sym->u.s.redirect)
{
- case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break;
case SYMBOL_LOCALIZED:
{ /* Look in local_var_alist. */
diff --git a/src/data.c b/src/data.c
index 4ab37e86ce5..8f9ee63e779 100644
--- a/src/data.c
+++ b/src/data.c
@@ -683,7 +683,7 @@ global value outside of any lexical scope. */)
switch (sym->u.s.redirect)
{
case SYMBOL_PLAINVAL: valcontents = SYMBOL_VAL (sym); break;
- case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_LOCALIZED:
{
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
@@ -1249,51 +1249,20 @@ The value, if non-nil, is a list of mode name symbols. */)
Getting and Setting Values of Symbols
***********************************************************************/
-/* Return the symbol holding SYMBOL's value. Signal
- `cyclic-variable-indirection' if SYMBOL's chain of variable
- indirections contains a loop. */
-
-struct Lisp_Symbol *
-indirect_variable (struct Lisp_Symbol *symbol)
-{
- struct Lisp_Symbol *tortoise, *hare;
-
- hare = tortoise = symbol;
-
- while (hare->u.s.redirect == SYMBOL_VARALIAS)
- {
- hare = SYMBOL_ALIAS (hare);
- if (hare->u.s.redirect != SYMBOL_VARALIAS)
- break;
-
- hare = SYMBOL_ALIAS (hare);
- tortoise = SYMBOL_ALIAS (tortoise);
-
- if (hare == tortoise)
- {
- Lisp_Object tem;
- XSETSYMBOL (tem, symbol);
- xsignal1 (Qcyclic_variable_indirection, tem);
- }
- }
-
- return hare;
-}
-
-
DEFUN ("indirect-variable", Findirect_variable, Sindirect_variable, 1, 1, 0,
doc: /* Return the variable at the end of OBJECT's variable chain.
If OBJECT is a symbol, follow its variable indirections (if any), and
return the variable at the end of the chain of aliases. See Info node
`(elisp)Variable Aliases'.
-If OBJECT is not a symbol, just return it. If there is a loop in the
-chain of aliases, signal a `cyclic-variable-indirection' error. */)
+If OBJECT is not a symbol, just return it. */)
(Lisp_Object object)
{
if (SYMBOLP (object))
{
- struct Lisp_Symbol *sym = indirect_variable (XSYMBOL (object));
+ struct Lisp_Symbol *sym = XSYMBOL (object);
+ while (sym->u.s.redirect == SYMBOL_VARALIAS)
+ sym = SYMBOL_ALIAS (sym);
XSETSYMBOL (object, sym);
}
return object;
@@ -1582,7 +1551,7 @@ find_symbol_value (Lisp_Object symbol)
start:
switch (sym->u.s.redirect)
{
- case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
case SYMBOL_LOCALIZED:
{
@@ -1671,7 +1640,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
start:
switch (sym->u.s.redirect)
{
- case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return;
case SYMBOL_LOCALIZED:
{
@@ -1925,7 +1894,7 @@ default_value (Lisp_Object symbol)
start:
switch (sym->u.s.redirect)
{
- case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
case SYMBOL_LOCALIZED:
{
@@ -2019,7 +1988,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value,
start:
switch (sym->u.s.redirect)
{
- case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: set_internal (symbol, value, Qnil, bindflag); return;
case SYMBOL_LOCALIZED:
{
@@ -2157,7 +2126,7 @@ See also `defvar-local'. */)
start:
switch (sym->u.s.redirect)
{
- case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL:
forwarded = 0; valcontents.value = SYMBOL_VAL (sym);
if (BASE_EQ (valcontents.value, Qunbound))
@@ -2225,7 +2194,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
start:
switch (sym->u.s.redirect)
{
- case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL:
forwarded = 0; valcontents.value = SYMBOL_VAL (sym); break;
case SYMBOL_LOCALIZED:
@@ -2311,7 +2280,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
start:
switch (sym->u.s.redirect)
{
- case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: return variable;
case SYMBOL_FORWARDED:
{
@@ -2378,7 +2347,7 @@ Also see `buffer-local-boundp'.*/)
start:
switch (sym->u.s.redirect)
{
- case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: return Qnil;
case SYMBOL_LOCALIZED:
{
@@ -2428,7 +2397,7 @@ value in BUFFER, or if VARIABLE is automatically buffer-local (see
start:
switch (sym->u.s.redirect)
{
- case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: return Qnil;
case SYMBOL_LOCALIZED:
{
@@ -2463,7 +2432,7 @@ If the current binding is global (the default), the value is nil. */)
start:
switch (sym->u.s.redirect)
{
- case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: return Qnil;
case SYMBOL_FORWARDED:
{
diff --git a/src/eval.c b/src/eval.c
index 545a280ae91..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)
{
@@ -3476,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. */
diff --git a/src/lisp.h b/src/lisp.h
index 165fa47b0b3..78b68880702 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3965,7 +3965,6 @@ extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2,
extern intmax_t cons_to_signed (Lisp_Object, intmax_t, intmax_t);
extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t);
-extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *);
extern AVOID args_out_of_range (Lisp_Object, Lisp_Object);
extern AVOID circular_list (Lisp_Object);
extern Lisp_Object do_symval_forwarding (lispfwd);