From: Stefan Monnier Date: Sat, 28 Oct 2023 00:18:54 +0000 (-0400) Subject: (provided-mode-derived-p): Fix alias case X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=81510f2fff5e61c6fca359e01870139f1302e1ed;p=emacs.git (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 12e33380260..d4173b4daba 100644 --- 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 0d409cead26..db327056533 100644 --- 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