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 /test | |
| 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 'test')
| -rw-r--r-- | test/lisp/help-fns-tests.el | 4 | ||||
| -rw-r--r-- | test/lisp/subr-tests.el | 10 | ||||
| -rw-r--r-- | test/src/data-tests.el | 36 |
3 files changed, 42 insertions, 8 deletions
diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index 4d715cde1d5..243a45ae6d2 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el | |||
| @@ -181,10 +181,6 @@ Return first line of the output of (describe-function-1 FUNC)." | |||
| 181 | (ert-deftest help-fns--analyze-function-recursive () | 181 | (ert-deftest help-fns--analyze-function-recursive () |
| 182 | (defalias 'help-fns--a 'help-fns--b) | 182 | (defalias 'help-fns--a 'help-fns--b) |
| 183 | (should (equal (help-fns--analyze-function 'help-fns--a) | 183 | (should (equal (help-fns--analyze-function 'help-fns--a) |
| 184 | '(help-fns--a help-fns--b t help-fns--b))) | ||
| 185 | ;; Make a loop and see that it doesn't infloop. | ||
| 186 | (defalias 'help-fns--b 'help-fns--a) | ||
| 187 | (should (equal (help-fns--analyze-function 'help-fns--a) | ||
| 188 | '(help-fns--a help-fns--b t help-fns--b)))) | 184 | '(help-fns--a help-fns--b t help-fns--b)))) |
| 189 | 185 | ||
| 190 | ;;; help-fns-tests.el ends here | 186 | ;;; help-fns-tests.el ends here |
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 1abd3be4ea1..d5efabc1370 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el | |||
| @@ -1058,10 +1058,12 @@ final or penultimate step during initialization.")) | |||
| 1058 | '(subr-tests--b subr-tests--c))) | 1058 | '(subr-tests--b subr-tests--c))) |
| 1059 | 1059 | ||
| 1060 | (defalias 'subr-tests--d 'subr-tests--e) | 1060 | (defalias 'subr-tests--d 'subr-tests--e) |
| 1061 | (defalias 'subr-tests--e 'subr-tests--d) | 1061 | (should (equal (function-alias-p 'subr-tests--d) |
| 1062 | (should-error (function-alias-p 'subr-tests--d)) | 1062 | '(subr-tests--e))) |
| 1063 | (should (equal (function-alias-p 'subr-tests--d t) | 1063 | |
| 1064 | '(subr-tests--e)))) | 1064 | (fset 'subr-tests--f 'subr-tests--a) |
| 1065 | (should (equal (function-alias-p 'subr-tests--f) | ||
| 1066 | '(subr-tests--a subr-tests--b subr-tests--c)))) | ||
| 1065 | 1067 | ||
| 1066 | (ert-deftest test-readablep () | 1068 | (ert-deftest test-readablep () |
| 1067 | (should (readablep "foo")) | 1069 | (should (readablep "foo")) |
diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 28cee9d2c5b..680fdd57d71 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el | |||
| @@ -772,4 +772,40 @@ comparing the subr with a much slower Lisp implementation." | |||
| 772 | "Can't set variable marked with 'make_symbol_constant'." | 772 | "Can't set variable marked with 'make_symbol_constant'." |
| 773 | (should-error (setq most-positive-fixnum 1) :type 'setting-constant)) | 773 | (should-error (setq most-positive-fixnum 1) :type 'setting-constant)) |
| 774 | 774 | ||
| 775 | (ert-deftest data-tests-fset () | ||
| 776 | (fset 'data-tests--fs-fun (lambda () 'moo)) | ||
| 777 | (declare-function data-tests--fs-fun nil) | ||
| 778 | (should (equal (data-tests--fs-fun) 'moo)) | ||
| 779 | |||
| 780 | (fset 'data-tests--fs-fun1 'data-tests--fs-fun) | ||
| 781 | (declare-function data-tests--fs-fun1 nil) | ||
| 782 | (should (equal (data-tests--fs-fun1) 'moo)) | ||
| 783 | |||
| 784 | (fset 'data-tests--fs-a 'data-tests--fs-b) | ||
| 785 | (fset 'data-tests--fs-b 'data-tests--fs-c) | ||
| 786 | |||
| 787 | (should-error (fset 'data-tests--fs-c 'data-tests--fs-c) | ||
| 788 | :type 'cyclic-function-indirection) | ||
| 789 | (fset 'data-tests--fs-d 'data-tests--fs-a) | ||
| 790 | (should-error (fset 'data-tests--fs-c 'data-tests--fs-d) | ||
| 791 | :type 'cyclic-function-indirection)) | ||
| 792 | |||
| 793 | (ert-deftest data-tests-defalias () | ||
| 794 | (defalias 'data-tests--da-fun (lambda () 'baa)) | ||
| 795 | (declare-function data-tests--da-fun nil) | ||
| 796 | (should (equal (data-tests--da-fun) 'baa)) | ||
| 797 | |||
| 798 | (defalias 'data-tests--da-fun1 'data-tests--da-fun) | ||
| 799 | (declare-function data-tests--da-fun1 nil) | ||
| 800 | (should (equal (data-tests--da-fun1) 'baa)) | ||
| 801 | |||
| 802 | (defalias 'data-tests--da-a 'data-tests--da-b) | ||
| 803 | (defalias 'data-tests--da-b 'data-tests--da-c) | ||
| 804 | |||
| 805 | (should-error (defalias 'data-tests--da-c 'data-tests--da-c) | ||
| 806 | :type 'cyclic-function-indirection) | ||
| 807 | (defalias 'data-tests--da-d 'data-tests--da-a) | ||
| 808 | (should-error (defalias 'data-tests--da-c 'data-tests--da-d) | ||
| 809 | :type 'cyclic-function-indirection)) | ||
| 810 | |||
| 775 | ;;; data-tests.el ends here | 811 | ;;; data-tests.el ends here |