mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 14:30:50 -08:00
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)
|
(cons . consp)
|
||||||
(fixnum . fixnump)
|
(fixnum . fixnump)
|
||||||
(float . floatp)
|
(float . floatp)
|
||||||
|
(frame . framep)
|
||||||
(function . functionp)
|
(function . functionp)
|
||||||
(integer . integerp)
|
(integer . integerp)
|
||||||
(keyword . keywordp)
|
(keyword . keywordp)
|
||||||
(list . listp)
|
(list . listp)
|
||||||
|
(marker . markerp)
|
||||||
(natnum . natnump)
|
(natnum . natnump)
|
||||||
(number . numberp)
|
(number . numberp)
|
||||||
(null . null)
|
(null . null)
|
||||||
|
(overlay . overlayp)
|
||||||
(real . numberp)
|
(real . numberp)
|
||||||
(sequence . sequencep)
|
(sequence . sequencep)
|
||||||
(subr . subrp)
|
(subr . subrp)
|
||||||
(string . stringp)
|
(string . stringp)
|
||||||
(symbol . symbolp)
|
(symbol . symbolp)
|
||||||
(vector . vectorp)
|
(vector . vectorp)
|
||||||
|
(window . windowp)
|
||||||
;; FIXME: Do we really want to consider this a type?
|
;; FIXME: Do we really want to consider this a type?
|
||||||
(integer-or-marker . integer-or-marker-p)
|
(integer-or-marker . integer-or-marker-p)
|
||||||
))
|
))
|
||||||
|
|
@ -3475,6 +3479,8 @@ 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)))
|
(inline-quote (funcall #',(get type 'cl-deftype-satisfies) ,val)))
|
||||||
((and (or 'nil 't) type) (inline-quote ',type))
|
((and (or 'nil 't) type) (inline-quote ',type))
|
||||||
((and (pred symbolp) type)
|
((and (pred symbolp) type)
|
||||||
|
(macroexp-warn-and-return
|
||||||
|
(format-message "Unknown type: %S" type)
|
||||||
(let* ((name (symbol-name type))
|
(let* ((name (symbol-name type))
|
||||||
(namep (intern (concat name "p"))))
|
(namep (intern (concat name "p"))))
|
||||||
(cond
|
(cond
|
||||||
|
|
@ -3483,8 +3489,9 @@ Of course, we really can't know that for sure, so it's just a heuristic."
|
||||||
(setq namep (intern (concat name "-p"))))
|
(setq namep (intern (concat name "-p"))))
|
||||||
(inline-quote (funcall #',namep ,val)))
|
(inline-quote (funcall #',namep ,val)))
|
||||||
((cl--macroexp-fboundp type) (inline-quote (funcall #',type ,val)))
|
((cl--macroexp-fboundp type) (inline-quote (funcall #',type ,val)))
|
||||||
(t (error "Unknown type %S" type)))))
|
(t (error "Unknown type %S" type))))
|
||||||
(type (error "Bad type spec: %s" type)))))
|
nil nil type))
|
||||||
|
(type (error "Bad type spec: %S" type)))))
|
||||||
|
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
|
|
|
||||||
|
|
@ -152,7 +152,7 @@ supertypes from the most specific to least specific.")
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun cl-struct-define (name docstring parent type named slots children-sym
|
(defun cl-struct-define (name docstring parent type named slots children-sym
|
||||||
tag print)
|
tag print)
|
||||||
(cl-check-type name cl--struct-name)
|
(cl-check-type name (satisfies cl--struct-name-p))
|
||||||
(unless type
|
(unless type
|
||||||
;; Legacy defstruct, using tagged vectors. Enable backward compatibility.
|
;; Legacy defstruct, using tagged vectors. Enable backward compatibility.
|
||||||
(cl-old-struct-compat-mode 1))
|
(cl-old-struct-compat-mode 1))
|
||||||
|
|
|
||||||
|
|
@ -137,6 +137,8 @@ Currently under control of this var:
|
||||||
X can also be is a symbol."
|
X can also be is a symbol."
|
||||||
(eieio--class-p (if (symbolp x) (cl--find-class x) x)))
|
(eieio--class-p (if (symbolp x) (cl--find-class x) x)))
|
||||||
|
|
||||||
|
(cl-deftype class () `(satisfies class-p))
|
||||||
|
|
||||||
(defun eieio--class-print-name (class)
|
(defun eieio--class-print-name (class)
|
||||||
"Return a printed representation of CLASS."
|
"Return a printed representation of CLASS."
|
||||||
(format "#<class %s>" (eieio-class-name class)))
|
(format "#<class %s>" (eieio-class-name class)))
|
||||||
|
|
@ -165,6 +167,8 @@ Return nil if that option doesn't exist."
|
||||||
(and (recordp obj)
|
(and (recordp obj)
|
||||||
(eieio--class-p (eieio--object-class 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")
|
(define-obsolete-function-alias 'object-p #'eieio-object-p "25.1")
|
||||||
|
|
||||||
(defun class-abstract-p (class)
|
(defun class-abstract-p (class)
|
||||||
|
|
|
||||||
|
|
@ -271,7 +271,8 @@ This method is obsolete."
|
||||||
;; test, so we can let typep have the CLOS documented behavior
|
;; test, so we can let typep have the CLOS documented behavior
|
||||||
;; while keeping our above predicate clean.
|
;; 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)
|
(eieio-defclass-internal ',name ',superclasses ',slots ',options-and-doc)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -5354,7 +5354,14 @@ on a DOS/Windows machine, it returns FILENAME in expanded form."
|
||||||
(let ((fremote (file-remote-p filename))
|
(let ((fremote (file-remote-p filename))
|
||||||
(dremote (file-remote-p directory))
|
(dremote (file-remote-p directory))
|
||||||
(fold-case (or (file-name-case-insensitive-p filename)
|
(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
|
(if ;; Conditions for separate trees
|
||||||
(or
|
(or
|
||||||
;; Test for different filesystems on DOS/Windows
|
;; Test for different filesystems on DOS/Windows
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue