emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/compat dd334e5616 04/84: Add function-alias-p


From: ELPA Syncer
Subject: [elpa] externals/compat dd334e5616 04/84: Add function-alias-p
Date: Tue, 3 Jan 2023 08:57:30 -0500 (EST)

branch: externals/compat
commit dd334e5616d794f9c761402fa77686d342ef790f
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    Add function-alias-p
---
 compat-29.1.el  | 26 +++++++++++++++++++++++++-
 compat-tests.el | 21 +++++++++++++++++++++
 2 files changed, 46 insertions(+), 1 deletion(-)

diff --git a/compat-29.1.el b/compat-29.1.el
index 3564270d81..507219b27b 100644
--- a/compat-29.1.el
+++ b/compat-29.1.el
@@ -30,6 +30,30 @@
 (eval-when-compile (require 'compat-macs))
 (declare-function compat-maxargs-/= "compat" (func n))
 
+;;;; Defined in subr.el
+
+(compat-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)
+             (signal 'cyclic-function-indirection (list orig-func))))
+         (push func chain))
+       chain))))
+
 ;;;; Defined in subr-x.el
 
 (compat-defun string-limit (string length &optional end coding-system)
@@ -51,7 +75,7 @@ character.
 When shortening strings for display purposes,
 `truncate-string-to-width' is almost always a better alternative
 than this function."
-  :feature subr-x
+  :feature 'subr-x
   (unless (natnump length)
     (signal 'wrong-type-argument (list 'natnump length)))
   (if coding-system
diff --git a/compat-tests.el b/compat-tests.el
index 4a4ab25a27..20dd733aad 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1361,6 +1361,27 @@ the compatibility function."
     (compat--error wrong-type-argument 'a 2)
     (compat--error wrong-type-argument 'a 'b)))
 
+(ert-deftest compat-function-alias-p ()
+  "Check if `compat--function-alias-p' was implemented properly."
+  (let* ((f (gensym))
+         (g (gensym)) (h (gensym))
+         (a (gensym)) (b (gensym)))
+    (defalias f #'ignore)
+    (defalias g f)
+    (defalias h g)
+    (defalias a b)
+    (defalias b a)
+
+    (compat-test function-alias-p
+      (compat--should nil nil)
+      (compat--should nil "")
+      (compat--should nil #'ignore)
+      (compat--should nil #'ignore)
+      (compat--should (list #'ignore) f)
+      (compat--should (list f #'ignore) g)
+      (compat--should (list g f #'ignore) h)
+      (compat--error cyclic-function-indirection a)
+      (compat--should (list b) a t))))
 
 (provide 'compat-tests)
 ;;; compat-tests.el ends here



reply via email to

[Prev in Thread] Current Thread [Next in Thread]