From: David Ponce <da_vid@orange.fr>
Date: Wed, 7 May 2025 16:24:00 +0000 (-0400)
Subject: (cl-types-of): Fix two plain bugs
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e19a041e4eb8d9a403ed86403a5159be4efbeb57;p=emacs.git

(cl-types-of): Fix two plain bugs

* lisp/emacs-lisp/cl-extra.el (cl-types-of): Fix error handling.
Don't mutate `found` since it's stored as key in the hash-table.

(cherry picked from commit f6f35644b7f49732fe38fac3c199ef3a6a22abe7)
---

diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 6e32623ce0d..38b6bf7aac3 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -1037,24 +1037,26 @@ TYPES is an internal argument."
       (and
        ;; If OBJECT is of type, add type to the matching list.
        (if types
-           ;; For method dispatch, we don't need to filter out errors, since
-           ;; we can presume that method dispatch is used only on
+           ;; For method dispatch, we don't need to filter out errors,
+           ;; since we can presume that method dispatch is used only on
            ;; sanely-defined types.
            (cl-typep object type)
          (condition-case-unless-debug e
              (cl-typep object type)
            (error (setq cl--type-list (delq type cl--type-list))
                   (warn  "cl-types-of %S: %s"
-                         type (error-message-string e)))))
+                         type (error-message-string e))
+                  nil)))
        (push type found)))
     (push (cl-type-of object) found)
     ;; Return an unique value of the list of types OBJECT belongs to,
     ;; which is also the list of specifiers for OBJECT.
     (with-memoization (gethash found cl--type-unique)
       ;; Compute an ordered list of types from the DAG.
-      (merge-ordered-lists
-       (mapcar (lambda (type) (cl--class-allparents (cl--find-class type)))
-               (nreverse found))))))
+      (let (dag)
+        (dolist (type found)
+          (push (cl--class-allparents (cl--find-class type)) dag))
+        (merge-ordered-lists dag)))))
 
 (defvar cl--type-dispatch-list nil
   "List of types that need to be checked during dispatch.")