mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-07 06:50:23 -08:00
Code Issues Projects Releases Wiki Activity

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

Browse source 
* 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.
This commit is contained in:
David Ponce 2025-05-07 12:24:00 -04:00 • committed by Stefan Monnier
parent 2eb90d43e6
commit f6f35644b7
1 changed files with 8 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

14
lisp/emacs-lisp/cl-extra.el
View file

@ -1035,24 +1035,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.")