]> git.eshelyaron.com Git - emacs.git/commitdiff
(cl-types-of): Fix two plain bugs
authorDavid Ponce <da_vid@orange.fr>
Wed, 7 May 2025 16:24:00 +0000 (12:24 -0400)
committerEshel Yaron <me@eshelyaron.com>
Sat, 10 May 2025 08:54:03 +0000 (10:54 +0200)
* 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)

lisp/emacs-lisp/cl-extra.el

index 6e32623ce0df59afd1796c35ff41223b66ac8df1..38b6bf7aac3a027c63f85caaf707e9a34c08731a 100644 (file)
@@ -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.")