cl-types: Improve error messages

* lisp/emacs-lisp/cl-extra.el (cl--derived-type-generalizers):
Check that the type is valid and fully defined.

* lisp/emacs-lisp/cl-lib.el (cl-generic-generalizers) <derived-type>:
Don't delegate to another method just because the type is invalid.

* lisp/emacs-lisp/cl-preloaded.el (cl--define-derived-type):
Minor simplification, and improvement to an error message.

(cherry picked from commit ceba490da921399393200e704520d313eb1ac5c8)

diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 5569ec3d752a8c5ddd97f4b2845874c2d040d5f1..de7caab6b29b1db69011f22bc5e8ab5dea50a9c7 100644 (file)
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -1084,6 +1084,15 @@ TYPES is an internal argument."
 
 ;;;###autoload
 (defun cl--derived-type-generalizers (type)
+  ;; Make sure this derived type can be used without arguments.
+  (let ((expander (or (get type 'cl-deftype-handler)
+                      (error "Type %S lacks cl-deftype-handler" type))))
+    ;; Check that the type can be used without arguments.
+    (funcall expander)
+    ;; Check that we have a precomputed predicate since that's what
+    ;; `cl-types-of' uses.
+    (unless (get type 'cl-deftype-satisfies)
+      (error "Type %S lacks cl-deftype-satisfies" type)))
   ;; Add a new dispatch type to the dispatch list, then
   ;; synchronize with `cl--derived-type-list' so that both lists follow
   ;; the same type precedence order.

diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 745bdcfeeacc8d3a30663417706a28d63c3ea35b..8bad4fa74e6834828949655393eeb658a1edcf5e 100644 (file)
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -560,10 +560,7 @@ If ALIST is non-nil, the new pairs are prepended to it."
   (declare-function cl--derived-type-generalizers "cl-extra" (type))
   (cl-defmethod cl-generic-generalizers :extra "derived-types" (type)
     "Support for dispatch on derived types, i.e. defined with `cl-deftype'."
-    (if (and (symbolp type) (cl-derived-type-class-p (cl--find-class type))
-             ;; Make sure this derived type can be used without arguments.
-             (let ((expander (get type 'cl-deftype-handler)))
-               (and expander (with-demoted-errors "%S" (funcall expander)))))
+    (if (and (symbolp type) (cl-derived-type-class-p (cl--find-class type)))
         (cl--derived-type-generalizers type)
       (cl-call-next-method))))
 

diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index e4b467ceb2422c0cfa223183d3487d5c57dd37d5..d6962ba1dee8e0d0639cab5f9244274208810164 100644 (file)
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -505,37 +505,26 @@ PARENTS is a list of types NAME is a subtype of, or nil."
           ;; "complement" another declaration of the same type,
           ;; so maybe we should turn this into a warning (and
           ;; not overwrite the `cl--find-class' in that case)?
-          (error "Type in another class: %S" (type-of class))))
+          (error "Type %S already in another class: %S" name (type-of class))))
     ;; Setup a type descriptor for NAME.
     (setf (cl--find-class name)
           (cl--derived-type-class-make name (function-documentation expander)
                                        parents))
     (define-symbol-prop name 'cl-deftype-handler expander)
     (when predicate
-      (define-symbol-prop name 'cl-deftype-satisfies predicate))
-    ;; Record new type.  The constructor of the class
-    ;; `cl-type-class' already ensures that parent types must be
-    ;; defined before their "child" types (i.e. already added to
-    ;; the `cl--derived-type-list' for types defined with `cl-deftype').
-    ;; So it is enough to simply push a new type at the beginning
-    ;; of the list.
-    ;; Redefinition is more complicated, because child types may
-    ;; be in the list, so moving the type to the head can be
-    ;; incorrect.  The "cheap" solution is to leave the list
-    ;; unchanged (and hope the redefinition doesn't change the
-    ;; hierarchy too much).
-    ;; Side note: Redefinitions introduce other problems as well
-    ;; because the class object's `parents` slot contains
-    ;; references to `cl--class` objects, so after a redefinition
-    ;; via (setf (cl--find-class FOO) ...), the children's
-    ;; `parents` slots point to the old class object.  That's a
-    ;; problem that affects all types and that we don't really try
-    ;; to solve currently.
-    (or (memq name cl--derived-type-list)
-        ;; Exclude types that can't be used without arguments.
-        ;; They'd signal errors in `cl-types-of'!
-        (not predicate)
-        (push name cl--derived-type-list))))
+      (define-symbol-prop name 'cl-deftype-satisfies predicate)
+      ;; If the type can be used without arguments, record it for
+      ;; use by `cl-types-of'.
+      ;; The order in `cl--derived-type-list' is important, but the
+      ;; constructor of the class `cl-type-class' already ensures that
+      ;; parent types must be defined before their "child" types
+      ;; (i.e. already added to the `cl--derived-type-list' for types
+      ;; defined with `cl-deftype').  So it is enough to simply push
+      ;; a new type at the beginning of the list.
+      ;; Redefinition is a can of worms anyway, so we don't try to be clever
+      ;; in that case.
+      (or (memq name cl--derived-type-list)
+          (push name cl--derived-type-list)))))
 
 ;; Make sure functions defined with cl-defsubst can be inlined even in
 ;; packages which do not require CL.  We don't put an autoload cookie