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.

diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 5584cbce9a66a5683707dedbc8ff4514b708c0f3..f92c02ae5edeac1167642a645e84b905919fcd92 100644 (file)
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -2558,6 +2558,9 @@ documentation as @var{base-variable} has, if any, unless
 the documentation of the variable at the end of the chain of aliases.
 
 This function returns @var{base-variable}.
+
+If the resulting variable definition chain would be circular, then
+Emacs will signal a @code{cyclic-variable-indirection} error.
 @end defun
 
   Variable aliases are convenient for replacing an old name for a
@@ -2606,9 +2609,6 @@ look like:
 This function returns the variable at the end of the chain of aliases
 of @var{variable}.  If @var{variable} is not a symbol, or if @var{variable} is
 not defined as an alias, the function returns @var{variable}.
-
-This function signals a @code{cyclic-variable-indirection} error if
-there is a loop in the chain of symbols.
 @end defun
 
 @example

diff --git a/etc/NEWS b/etc/NEWS
index cf0e05078f5bf9e3ae249b68e0b8ebdc7430a8d1..b121002b246fb3d2640f886ec70aa6aad51c5f93 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -480,19 +480,19 @@ so it will return the remote UID for remote files (or -1 if the
 connection has no associated user).
 
 +++
-** 'fset' and 'defalias' now signal an error for circular alias chains.
-Previously, 'fset' and 'defalias' could be made to build circular
-function indirection chains as in
+** 'fset', 'defalias' and 'defvaralias' now signal an error for cyclic aliases.
+Previously, 'fset', 'defalias' and 'defvaralias' could be made to
+build circular function and variable indirection chains as in
 
     (defalias 'able 'baker)
     (defalias 'baker 'able)
 
-but trying to call them would often make Emacs hang.  Now, an attempt
+but trying to use them would sometimes make Emacs hang.  Now, an attempt
 to create such a loop results in an error.
 
-Since circular alias chains now cannot occur, 'function-alias-p' and
-'indirect-function' will never signal an error.  Their second
-'noerror' arguments have no effect and are therefore obsolete.
+Since circular alias chains now cannot occur, 'function-alias-p',
+'indirect-function' and 'indirect-variable' will never signal an error.
+Their 'noerror' arguments have no effect and are therefore obsolete.
 
 \f
 * Changes in Emacs 30.1 on Non-Free Operating Systems

diff --git a/src/buffer.c b/src/buffer.c
index 31c08cf36502efd40d4ec8502e685b4adbf08638..3e3be805a6d78949fed4f334861930a3dcbe95e1 100644 (file)
--- 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 4ab37e86ce5778ca9104c1137e95c18a909c205e..8f9ee63e779379909bc0dd71ef9f1a0208f62b5a 100644 (file)
--- 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 545a280ae91bc4088c2ecb4b124c664e98019ca5..cd3eb0a3676812ec4fc04c02e1f1080bcbf8b51e 100644 (file)
--- 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 165fa47b0b3c4e8545f9cbe429e2da1058d5a1ad..78b68880702004941ff21ba7668b38c7573ae2bf 100644 (file)
--- 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);

diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index e0a27439ba2aa2ee153b6aa628c60cf185713dc0..4589763b2f5e6ec150f7f229b8d5c26f4e1231f6 100644 (file)
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -266,4 +266,20 @@ expressions works for identifiers starting with period."
     )
   (should (eq eval-test--local-var 'global)))
 
+(ert-deftest eval-tests-defvaralias ()
+  (defvar eval-tests--my-var 'coo)
+  (defvaralias 'eval-tests--my-var1 'eval-tests--my-var)
+  (defvar eval-tests--my-var1)
+  (should (equal eval-tests--my-var 'coo))
+  (should (equal eval-tests--my-var1 'coo))
+
+  (defvaralias 'eval-tests--my-a 'eval-tests--my-b)
+  (defvaralias 'eval-tests--my-b 'eval-tests--my-c)
+
+  (should-error (defvaralias 'eval-tests--my-c 'eval-tests--my-c)
+                :type 'cyclic-variable-indirection)
+  (defvaralias 'eval-tests--my-d 'eval-tests--my-a)
+  (should-error (defvaralias 'eval-tests--my-c 'eval-tests--my-d)
+                :type 'cyclic-variable-indirection))
+
 ;;; eval-tests.el ends here