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

[Stefan Monnier]

branch: master
commit 5ee4209f307fdf8cde9775539c9596d29edccd6d
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    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`.
---
 lisp/emacs-lisp/cl-macs.el      | 27 +++++++++++++++++----------
 lisp/emacs-lisp/cl-preloaded.el |  2 +-
 lisp/emacs-lisp/eieio-core.el   |  4 ++++
 lisp/emacs-lisp/eieio.el        |  3 ++-
 lisp/files.el                   |  9 ++++++++-
 5 files changed, 32 insertions(+), 13 deletions(-)

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index a9d422929f..ada4f0344d 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 2b32bc4844..ec9fd86a55 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 d687289b22..d9864e6965 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 1315ca0c62..565eaf2d73 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 6c6fcbc55d..97e58946bd 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