Subject: Re: bug#77725: 31.0.50; Add support for types accepted by `cl-typep' to cl-generic?

From: David Ponce <[email-masked]>
Date: Mon, 19 May 2025 10:08:17 +0200

> Please find attached a proposal to improve error handling in
> `cl-types-of'.  Ultimately, I think you were right and it is better to
> simply report derived type errors to the caller and abort processing,
> but while also preventing their recurrence as much as possible :-)
> 
> So my proposal is to still handle any error on a derived type, in
> order to disable the type as is currently done by removing it from the
> list of types; but, instead of warn, raise a new `cl-type-error'
> mentioning the type in error and the underlying error.  Here are some
> simple examples for you to observe the result.
> 
> (cl-deftype T1 ()
>    '(satisfies plusp))
> 
> (cl-types-of -0.5)
> => (real float number number-or-marker atom t)
> 
> (cl-types-of 12)
> => (T1 real base-char character fixnum natnum integer number integer-or-marker number-or-marker atom t)
> 
> (cl-types-of "12")
> => Error on derived type: T1, (wrong-type-argument number-or-marker-p "12")
> 
> (cl-deftype T2 ()
>    `(satisfies ,(lambda (o) (memq 'T1 (cl-types-of o)))))
> 
> (cl-types-of "12")
> => Error on derived type: T2, (excessive-lisp-nesting 1601)
> 
> Does it make sense?

Please find attached a better patch, and a possible change log below.
Thanks
David

2025-05-19  David Ponce  <[email-masked]>

	Signal a `cl-type-error' instead of warning when a derived type
	encounters an error.

	* lisp/emacs-lisp/cl-extra.el (cl-type-error): New error symbol.
	(cl-types-of): Use it.
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 1fe0411062f..7c019d13f3d 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -1025,6 +1025,8 @@ cl--types-of-memo
 ;; - in `cl-types-of' start by calling `cl-type-of', then use the map
 ;;   to find which cl-types may need to be checked.
 ;;
+(define-error 'cl-type-error "Error on derived type")
+
 ;;;###autoload
 (defun cl-types-of (object &optional types)
   "Return the atomic types OBJECT belongs to.
@@ -1044,11 +1046,18 @@ cl-types-of
              (funcall pred object)
            (condition-case-unless-debug e
                (funcall pred object)
-             (error (setq cl--derived-type-list
-                          (delq type cl--derived-type-list))
-                    (warn  "cl-types-of %S: %s"
-                           type (error-message-string e))
-                    nil)))
+             ;; Catching `cl-type-error' means it comes from recursive
+             ;; calls to `cl-types-of', so propagate the error until
+             ;; escaping the outermost call to `cl-types-of'.
+             (cl-type-error
+              (signal (car e) (cdr e)))
+             (error
+              ;; If checking TYPE signals an error, disable TYPE and
+              ;; signal a `cl-type-error' error mentioning TYPE and
+              ;; the underlying error.
+              (setq cl--derived-type-list
+                    (delq type cl--derived-type-list))
+              (signal 'cl-type-error (list type e)))))
          (push type found))))
     (push (cl-type-of object) found)
     ;; Return the list of types OBJECT belongs to, which is also the list