aboutsummaryrefslogtreecommitdiffstats
path: root/test
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 /test
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 'test')
-rw-r--r--test/lisp/help-fns-tests.el4
-rw-r--r--test/lisp/subr-tests.el10
-rw-r--r--test/src/data-tests.el36
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