Add new function function-alias-p

* doc/lispref/functions.texi (Defining Functions): Document it.
* lisp/subr.el (function-alias-p): New function (bug#53178).

4 files changed, 61 insertions, 0 deletions

diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 96fecc8c892..caf8e3444fe 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -669,6 +669,23 @@ purposes, it is better to use @code{fset}, which does not keep such
 records.  @xref{Function Cells}.
 @end defun
 
+@defun function-alias-p object &optional noerror
+Use the @code{function-alias-p} function to check whether an object is
+a function alias.  If it isn't, this predicate will return
+non-@code{nil}.  If it is, the value returned will be a list of symbol
+representing the function alias chain.  For instance, if @code{a} is
+an alias for @code{b}, and @code{b} is an alias for @code{c}:
+
+@example
+(function-alias-p 'a)
+    @result{} (b c)
+@end example
+
+If there's a loop in the definitions, an error will be signalled.  If
+@var{noerror} is non-@code{nil}, the non-looping parts of the chain is
+returned instead.
+@end defun
+
   You cannot create a new primitive function with @code{defun} or
 @code{defalias}, but you can use them to change the function definition of
 any symbol, even one such as @code{car} or @code{x-popup-menu} whose
diff --git a/etc/NEWS b/etc/NEWS
index 6df77624a27..0cd4322a5e9 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -936,6 +936,11 @@ The input must be encoded text.
 * Lisp Changes in Emacs 29.1
 
 +++
+** New function 'function-alias-p'.
+This predicate says whether an object is a function alias, and if it
+is, the alias chain is returned.
+
++++
 ** New variable 'lisp-directory' holds the directory of Emacs's own Lisp files.
 
 +++
diff --git a/lisp/subr.el b/lisp/subr.el
index 12a5c2a10bc..b0d2ab623b1 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -6537,4 +6537,26 @@ string will be displayed only if BODY takes longer than TIMEOUT seconds.
                                  (lambda ()
                                    ,@body)))
 
+(defun function-alias-p (func &optional noerror)
+  "Return nil if FUNC is not a function alias.
+If FUNC is a function alias, return the function alias chain.
+
+If the function alias chain contains loops, an error will be
+signalled.  If NOERROR, the non-loop parts of the chain is returned."
+  (declare (side-effect-free t))
+  (let ((chain nil)
+        (orig-func func))
+    (nreverse
+     (catch 'loop
+       (while (and (symbolp func)
+                   (setq func (symbol-function func))
+                   (symbolp func))
+         (when (or (memq func chain)
+                   (eq func orig-func))
+           (if noerror
+               (throw 'loop chain)
+             (error "Alias loop for `%s'" orig-func)))
+         (push func chain))
+       chain))))
+
 ;;; subr.el ends here
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 9be7511bdc9..512b6545355 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1007,5 +1007,22 @@ final or penultimate step during initialization."))
   (should (equal (ensure-list :foo) '(:foo)))
   (should (equal (ensure-list '(1 2 3)) '(1 2 3))))
 
+(ert-deftest test-alias-p ()
+  (should-not (function-alias-p 1))
+
+  (defun subr-tests--fun ())
+  (should-not (function-alias-p 'subr-tests--fun))
+
+  (defalias 'subr-tests--a 'subr-tests--b)
+  (defalias 'subr-tests--b 'subr-tests--c)
+  (should (equal (function-alias-p 'subr-tests--a)
+                 '(subr-tests--b subr-tests--c)))
+
+  (defalias 'subr-tests--d 'subr-tests--e)
+  (defalias 'subr-tests--e 'subr-tests--d)
+  (should-error (function-alias-p 'subr-tests--d))
+  (should (equal (function-alias-p 'subr-tests--d t)
+                 '(subr-tests--e))))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here