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`.

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index a9d422929f162ac89156caa6e4bc1300d33709e3..ada4f0344d394602f02febc1a35145857a130550 100644 (file)
--- 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 2b32bc4844af9d9b9c03a8b4d346f510abfff398..ec9fd86a55cc16708614da054df36a4ed4315efa 100644 (file)
--- 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 d687289b22fd1959edb172726d459aa10ae82c62..d9864e6965d760e2917b90052263ccd5fabda4c0 100644 (file)
--- 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 1315ca0c6276cbb28725c6cab93dad7f47675c88..565eaf2d73370f54fdb1373c63365fe13f53a7bc 100644 (file)
--- 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 6c6fcbc55d30817e0bfd0e3e090d4997719882e4..97e58946bdafe5c855affcd5513857eedd73742b 100644 (file)
--- 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