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`.
This commit is contained in:
Stefan Monnier 2022-06-06 00:04:00 -04:00
parent b90d2a6a63
commit 5ee4209f30
5 changed files with 32 additions and 13 deletions

View file

@ -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

View file

@ -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))

View file

@ -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)

View file

@ -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)