master c60b59e04c3: Disallow creation of circular variable alias chains

[Mattias Engdegård]

branch: master
commit c60b59e04c3776a90adaa8c8fe53af3075a833b8
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    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.
---
 doc/lispref/variables.texi |  6 ++---
 etc/NEWS                   | 14 +++++------
 src/buffer.c               |  2 +-
 src/data.c                 | 61 ++++++++++++----------------------------------
 src/eval.c                 | 22 +++++++++++++----
 src/lisp.h                 |  1 -
 test/src/eval-tests.el     | 16 ++++++++++++
 7 files changed, 59 insertions(+), 63 deletions(-)

diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 5584cbce9a6..f92c02ae5ed 100644
--- 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 cf0e05078f5..b121002b246 100644
--- 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.
 
 
 * Changes in Emacs 30.1 on Non-Free Operating Systems
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);
diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index e0a27439ba2..4589763b2f5 100644
--- 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