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:
parent
b90d2a6a63
commit
5ee4209f30
5 changed files with 32 additions and 13 deletions
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue