diff options
| author | Mattias EngdegÄrd | 2023-02-20 15:23:12 +0100 |
|---|---|---|
| committer | Mattias EngdegÄrd | 2023-02-21 10:42:00 +0100 |
| commit | db3fea2e5ce46229ae40aa9ca6a89964261a7a5a (patch) | |
| tree | 43264b77f2bc165a310090c40065ee6dfc750169 /src | |
| parent | c4c4af022d6091537fb0d748342eba5e7d3ddd23 (diff) | |
| download | emacs-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.c | 63 | ||||
| -rw-r--r-- | src/eval.c | 2 |
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 | ||
| 842 | DEFUN ("fset", Ffset, Sfset, 2, 2, 0, | 842 | DEFUN ("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. |
| 844 | If the resulting chain of function definitions would contain a loop, | ||
| 845 | signal 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. | |||
| 1078 | Value, if non-nil, is a list (interactive SPEC). */) | 1086 | Value, 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. | |||
| 1168 | The value, if non-nil, is a list of mode name symbols. */) | 1176 | The 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. */ | ||
| 2490 | Lisp_Object | 2494 | Lisp_Object |
| 2491 | indirect_function (register Lisp_Object object) | 2495 | indirect_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 | ||
| 2515 | DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 2, 0, | 2502 | DEFUN ("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. |
| 2517 | If OBJECT is not a symbol, just return it. Otherwise, follow all | 2504 | If OBJECT is not a symbol, just return it. Otherwise, follow all |
| 2518 | function indirections to find the final function binding and return it. | 2505 | function indirections to find the final function binding and return it. */) |
| 2519 | Signal a cyclic-function-indirection error if there is a loop in the | 2506 | (Lisp_Object object, Lisp_Object noerror) |
| 2520 | function 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 | ||