cl-typep: Emit warning when using a type not known to be a type

`cl-typep` has used a heuristic that if there's a `<foo>-p` function,
then <foo> can be used as a type.  This made sense in the past where
most types were not officially declared to be (cl-)types, but nowadays
this just encourages abuses such as using `cl-typecase` with
"types" like `fbound`.  It's also a problem for EIEIO objects, where
for historical reasons `<foo>-p` tests if the object is of type
exactly `<foo>` whereas (cl-typep OBJ <foo>) should instead test
if OBJ is a *subtype* of `<foo>`.

So we change `cl-typep` to emit a warning whenever this "-p" heuristic
is used, to discourage abuses, encourage the use of explicit
`cl-deftype` declarations, and try and detect some misuses of
`<foo>-p` for EIEIO objects.

* lisp/emacs-lisp/eieio.el (defclass): Define as type not only at
run-time but also for the current compilation unit.

* lisp/emacs-lisp/eieio-core.el (class, eieio-object): Define as types.

* lisp/emacs-lisp/cl-preloaded.el (cl-struct-define): Don't abuse the
"-p" heuristic.

* lisp/emacs-lisp/cl-macs.el (cl-deftype-satisfies):
Add entries for frames, windows, markers, and overlays.
(cl-typep): Emit a warning when using a predicate that is not known to
correspond to a type.

* lisp/files.el (file-relative-name): Fix error that can trigger if
there's an(other) error between loading `files.el` and loading
`minibuffer.el`.

5 files changed, 32 insertions, 13 deletions

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index a9d422929f1..ada4f0344d3 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -3412,19 +3412,23 @@ Of course, we really can't know that for sure, so it's just a heuristic."
                  (cons		. consp)
                  (fixnum	. fixnump)
                  (float		. floatp)
+                 (frame		. framep)
                  (function	. functionp)
                  (integer	. integerp)
                  (keyword	. keywordp)
                  (list		. listp)
+                 (marker	. markerp)
                  (natnum	. natnump)
                  (number	. numberp)
                  (null		. null)
+                 (overlay	. overlayp)
                  (real		. numberp)
                  (sequence	. sequencep)
                  (subr		. subrp)
                  (string	. stringp)
                  (symbol	. symbolp)
                  (vector	. vectorp)
+                 (window	. windowp)
                  ;; FIXME: Do we really want to consider this a type?
                  (integer-or-marker . integer-or-marker-p)
                  ))
@@ -3475,16 +3479,19 @@ Of course, we really can't know that for sure, so it's just a heuristic."
        (inline-quote (funcall #',(get type 'cl-deftype-satisfies) ,val)))
       ((and (or 'nil 't) type) (inline-quote ',type))
       ((and (pred symbolp) type)
-       (let* ((name (symbol-name type))
-              (namep (intern (concat name "p"))))
-         (cond
-          ((cl--macroexp-fboundp namep) (inline-quote (funcall #',namep ,val)))
-          ((cl--macroexp-fboundp
-            (setq namep (intern (concat name "-p"))))
-           (inline-quote (funcall #',namep ,val)))
-          ((cl--macroexp-fboundp type) (inline-quote (funcall #',type ,val)))
-          (t (error "Unknown type %S" type)))))
-      (type (error "Bad type spec: %s" type)))))
+       (macroexp-warn-and-return
+        (format-message "Unknown type: %S" type)
+        (let* ((name (symbol-name type))
+               (namep (intern (concat name "p"))))
+          (cond
+           ((cl--macroexp-fboundp namep) (inline-quote (funcall #',namep ,val)))
+           ((cl--macroexp-fboundp
+             (setq namep (intern (concat name "-p"))))
+            (inline-quote (funcall #',namep ,val)))
+           ((cl--macroexp-fboundp type) (inline-quote (funcall #',type ,val)))
+           (t (error "Unknown type %S" type))))
+        nil nil type))
+      (type (error "Bad type spec: %S" type)))))
 
 
 ;;;###autoload
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index 2b32bc4844a..ec9fd86a55c 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -152,7 +152,7 @@ supertypes from the most specific to least specific.")
 ;;;###autoload
 (defun cl-struct-define (name docstring parent type named slots children-sym
                               tag print)
-  (cl-check-type name cl--struct-name)
+  (cl-check-type name (satisfies cl--struct-name-p))
   (unless type
     ;; Legacy defstruct, using tagged vectors.  Enable backward compatibility.
     (cl-old-struct-compat-mode 1))
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index d687289b22f..d9864e6965d 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -137,6 +137,8 @@ Currently under control of this var:
 X can also be is a symbol."
   (eieio--class-p (if (symbolp x) (cl--find-class x) x)))
 
+(cl-deftype class () `(satisfies class-p))
+
 (defun eieio--class-print-name (class)
   "Return a printed representation of CLASS."
   (format "#<class %s>" (eieio-class-name class)))
@@ -165,6 +167,8 @@ Return nil if that option doesn't exist."
   (and (recordp obj)
        (eieio--class-p (eieio--object-class obj))))
 
+(cl-deftype eieio-object () `(satisfies eieio-object-p))
+
 (define-obsolete-function-alias 'object-p #'eieio-object-p "25.1")
 
 (defun class-abstract-p (class)
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 1315ca0c627..565eaf2d733 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -271,7 +271,8 @@ This method is obsolete."
        ;; test, so we can let typep have the CLOS documented behavior
        ;; while keeping our above predicate clean.
 
-       (define-symbol-prop ',name 'cl-deftype-satisfies #',testsym2)
+       (eval-and-compile
+         (define-symbol-prop ',name 'cl-deftype-satisfies #',testsym2))
 
        (eieio-defclass-internal ',name ',superclasses ',slots ',options-and-doc)
 
diff --git a/lisp/files.el b/lisp/files.el
index 6c6fcbc55d3..97e58946bda 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5354,7 +5354,14 @@ on a DOS/Windows machine, it returns FILENAME in expanded form."
     (let ((fremote (file-remote-p filename))
 	  (dremote (file-remote-p directory))
 	  (fold-case (or (file-name-case-insensitive-p filename)
-			 read-file-name-completion-ignore-case)))
+			 ;; During bootstrap, it can happen that
+                         ;; `read-file-name-completion-ignore-case' is
+                         ;; not defined yet.
+                         ;; FIXME: `read-file-name-completion-ignore-case' is
+                         ;; a user-config which we shouldn't trust to reflect
+                         ;; the actual file system's semantics.
+			 (and (boundp 'read-file-name-completion-ignore-case)
+			      read-file-name-completion-ignore-case))))
       (if ;; Conditions for separate trees
 	  (or
 	   ;; Test for different filesystems on DOS/Windows