aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorMattias EngdegÄrd2023-02-20 15:23:12 +0100
committerMattias EngdegÄrd2023-02-21 10:42:00 +0100
commitdb3fea2e5ce46229ae40aa9ca6a89964261a7a5a (patch)
tree43264b77f2bc165a310090c40065ee6dfc750169 /src
parentc4c4af022d6091537fb0d748342eba5e7d3ddd23 (diff)
downloademacs-db3fea2e5ce46229ae40aa9ca6a89964261a7a5a.tar.gz
emacs-db3fea2e5ce46229ae40aa9ca6a89964261a7a5a.zip
Detect and prevent function alias loops in `fset` and `defalias`
Make `fset` and `defalias` signal an error on attempts to create circular alias chains. This is more effective, efficient and convenient than permitting alias loops to be created and trying to detect them at run time each time a function is called, which is what we have been doing until now, badly. * lisp/help-fns.el (help-fns--analyze-function): Don't pass obsolete argument. * lisp/subr.el (function-alias-p): * src/data.c (indirect_function, Findirect_function): Simplify. Now error-free, second argument obsolete. (Ffset): Detect loops. * test/lisp/help-fns-tests.el (help-fns--analyze-function-recursive): * test/lisp/subr-tests.el (test-alias-p): Adapt tests. * test/src/data-tests.el (data-tests-fset, data-tests-defalias): New. * doc/lispref/eval.texi (Function Indirection): * doc/lispref/functions.texi (Defining Functions, Function Cells): Update manual. * etc/NEWS: Announce.
Diffstat (limited to 'src')
-rw-r--r--src/data.c63
-rw-r--r--src/eval.c2
2 files changed, 20 insertions, 45 deletions
diff --git a/src/data.c b/src/data.c
index 1fa8b0358b5..d2f4d40d7bc 100644
--- a/src/data.c
+++ b/src/data.c
@@ -840,7 +840,9 @@ the position will be taken. */)
840} 840}
841 841
842DEFUN ("fset", Ffset, Sfset, 2, 2, 0, 842DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
843 doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION. */) 843 doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION.
844If the resulting chain of function definitions would contain a loop,
845signal a `cyclic-function-indirection' error. */)
844 (register Lisp_Object symbol, Lisp_Object definition) 846 (register Lisp_Object symbol, Lisp_Object definition)
845{ 847{
846 CHECK_SYMBOL (symbol); 848 CHECK_SYMBOL (symbol);
@@ -852,6 +854,12 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
852 854
853 eassert (valid_lisp_object_p (definition)); 855 eassert (valid_lisp_object_p (definition));
854 856
857 /* Ensure non-circularity. */
858 for (Lisp_Object s = definition; SYMBOLP (s) && !NILP (s);
859 s = XSYMBOL (s)->u.s.function)
860 if (EQ (s, symbol))
861 xsignal1 (Qcyclic_function_indirection, symbol);
862
855#ifdef HAVE_NATIVE_COMP 863#ifdef HAVE_NATIVE_COMP
856 register Lisp_Object function = XSYMBOL (symbol)->u.s.function; 864 register Lisp_Object function = XSYMBOL (symbol)->u.s.function;
857 865
@@ -1078,7 +1086,7 @@ If CMD is not a command, the return value is nil.
1078Value, if non-nil, is a list (interactive SPEC). */) 1086Value, if non-nil, is a list (interactive SPEC). */)
1079 (Lisp_Object cmd) 1087 (Lisp_Object cmd)
1080{ 1088{
1081 Lisp_Object fun = indirect_function (cmd); /* Check cycles. */ 1089 Lisp_Object fun = indirect_function (cmd);
1082 bool genfun = false; 1090 bool genfun = false;
1083 1091
1084 if (NILP (fun)) 1092 if (NILP (fun))
@@ -1168,7 +1176,7 @@ If COMMAND is not a command, the return value is nil.
1168The value, if non-nil, is a list of mode name symbols. */) 1176The value, if non-nil, is a list of mode name symbols. */)
1169 (Lisp_Object command) 1177 (Lisp_Object command)
1170{ 1178{
1171 Lisp_Object fun = indirect_function (command); /* Check cycles. */ 1179 Lisp_Object fun = indirect_function (command);
1172 1180
1173 if (NILP (fun)) 1181 if (NILP (fun))
1174 return Qnil; 1182 return Qnil;
@@ -2482,55 +2490,22 @@ If the current binding is global (the default), the value is nil. */)
2482 2490
2483/* If OBJECT is a symbol, find the end of its function chain and 2491/* If OBJECT is a symbol, find the end of its function chain and
2484 return the value found there. If OBJECT is not a symbol, just 2492 return the value found there. If OBJECT is not a symbol, just
2485 return it. If there is a cycle in the function chain, signal a 2493 return it. */
2486 cyclic-function-indirection error.
2487
2488 This is like Findirect_function, except that it doesn't signal an
2489 error if the chain ends up unbound. */
2490Lisp_Object 2494Lisp_Object
2491indirect_function (register Lisp_Object object) 2495indirect_function (Lisp_Object object)
2492{ 2496{
2493 Lisp_Object tortoise, hare; 2497 while (SYMBOLP (object) && !NILP (object))
2494 2498 object = XSYMBOL (object)->u.s.function;
2495 hare = tortoise = object; 2499 return object;
2496
2497 for (;;)
2498 {
2499 if (!SYMBOLP (hare) || NILP (hare))
2500 break;
2501 hare = XSYMBOL (hare)->u.s.function;
2502 if (!SYMBOLP (hare) || NILP (hare))
2503 break;
2504 hare = XSYMBOL (hare)->u.s.function;
2505
2506 tortoise = XSYMBOL (tortoise)->u.s.function;
2507
2508 if (EQ (hare, tortoise))
2509 xsignal1 (Qcyclic_function_indirection, object);
2510 }
2511
2512 return hare;
2513} 2500}
2514 2501
2515DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 2, 0, 2502DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 2, 0,
2516 doc: /* Return the function at the end of OBJECT's function chain. 2503 doc: /* Return the function at the end of OBJECT's function chain.
2517If OBJECT is not a symbol, just return it. Otherwise, follow all 2504If OBJECT is not a symbol, just return it. Otherwise, follow all
2518function indirections to find the final function binding and return it. 2505function indirections to find the final function binding and return it. */)
2519Signal a cyclic-function-indirection error if there is a loop in the 2506 (Lisp_Object object, Lisp_Object noerror)
2520function chain of symbols. */)
2521 (register Lisp_Object object, Lisp_Object noerror)
2522{ 2507{
2523 Lisp_Object result; 2508 return indirect_function (object);
2524
2525 /* Optimize for no indirection. */
2526 result = object;
2527 if (SYMBOLP (result) && !NILP (result)
2528 && (result = XSYMBOL (result)->u.s.function, SYMBOLP (result)))
2529 result = indirect_function (result);
2530 if (!NILP (result))
2531 return result;
2532
2533 return Qnil;
2534} 2509}
2535 2510
2536/* Extract and set vector and string elements. */ 2511/* Extract and set vector and string elements. */
diff --git a/src/eval.c b/src/eval.c
index e377e30c6fb..eb40c953f96 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2116,7 +2116,7 @@ then strings and vectors are not accepted. */)
2116 2116
2117 fun = function; 2117 fun = function;
2118 2118
2119 fun = indirect_function (fun); /* Check cycles. */ 2119 fun = indirect_function (fun);
2120 if (NILP (fun)) 2120 if (NILP (fun))
2121 return Qnil; 2121 return Qnil;
2122 2122