(provided-mode-derived-p): Fix alias case

The new handling of aliases in `provided-mode-derived-p`
introduced in Emacs-28.1 caused a regression where
(provided-mode-derived-p MODE MODE) returns nil if MODE is an alias.
Rework the loop so we consider an alias as a kind of parent.

* lisp/subr.el (provided-mode-derived-p): Step over aliases separately.

* test/lisp/subr-tests.el (subr-tests--derived-mode-1)
(subr-tests--derived-mode-2): Move out of `provided-mode-derived-p`
and give them properly namespaced names.
(provided-mode-derived-p): Add more tests for aliases.

diff --git a/lisp/subr.el b/lisp/subr.el
index 12e33380260ce730b1867169a61a0fec8570a24c..d4173b4dabaecd8e1f8260e29410a074ecdbb4bb 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2682,17 +2682,15 @@ The variable list SPEC is the same as in `if-let*'."
   "Non-nil if MODE is derived from one of MODES.
 Uses the `derived-mode-parent' property of the symbol to trace backwards.
 If you just want to check `major-mode', use `derived-mode-p'."
-  ;; If MODE is an alias, then look up the real mode function first.
   (declare (side-effect-free t))
-  (when-let ((alias (symbol-function mode)))
-    (when (symbolp alias)
-      (setq mode alias)))
   (while
       (and
        (not (memq mode modes))
-       (let* ((parent (get mode 'derived-mode-parent))
-              (parentfn (symbol-function parent)))
-         (setq mode (if (and parentfn (symbolp parentfn)) parentfn parent)))))
+       (let* ((parent (get mode 'derived-mode-parent)))
+        (setq mode (or parent
+                       ;; If MODE is an alias, then follow the alias.
+                       (let ((alias (symbol-function mode)))
+                         (and (symbolp alias) alias)))))))
   mode)
 
 (defun derived-mode-p (&rest modes)

diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 0d409cead26345d17037752d57b471088dbc0568..db32705653386657c09dc33f84b9de9a0473491d 100644 (file)
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -348,15 +348,17 @@
 (defalias 'subr-tests--parent-mode
   (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode))
 
+(define-derived-mode subr-tests--derived-mode-1 prog-mode "test")
+(define-derived-mode subr-tests--derived-mode-2 subr-tests--parent-mode "test")
 (ert-deftest provided-mode-derived-p ()
   ;; base case: `derived-mode' directly derives `prog-mode'
-  (should (progn
-            (define-derived-mode derived-mode prog-mode "test")
-            (provided-mode-derived-p 'derived-mode 'prog-mode)))
-  ;; edge case: `derived-mode' derives an alias of `prog-mode'
-  (should (progn
-            (define-derived-mode derived-mode subr-tests--parent-mode "test")
-            (provided-mode-derived-p 'derived-mode 'prog-mode))))
+  (should (provided-mode-derived-p 'subr-tests--derived-mode-1 'prog-mode))
+  ;; Edge cases: aliases along the derivation.
+  (should (provided-mode-derived-p 'subr-tests--parent-mode
+                                   'subr-tests--parent-mode))
+  (should (provided-mode-derived-p 'subr-tests--derived-mode-2
+                                   'subr-tests--parent-mode))
+  (should (provided-mode-derived-p 'subr-tests--derived-mode-2 'prog-mode)))
 
 (ert-deftest number-sequence-test ()
   (should (= (length