From: Stefan Monnier Date: Mon, 6 Jun 2022 04:04:00 +0000 (-0400) Subject: cl-typep: Emit warning when using a type not known to be a type X-Git-Tag: emacs-29.0.90~1910^2~201 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5ee4209f307fdf8cde9775539c9596d29edccd6d;p=emacs.git 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 `-p` function, then 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 `-p` tests if the object is of type exactly `` whereas (cl-typep OBJ ) should instead test if OBJ is a *subtype* of ``. 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 `-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 a9d422929f1..ada4f0344d3 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 2b32bc4844a..ec9fd86a55c 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 d687289b22f..d9864e6965d 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 "#" (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 1315ca0c627..565eaf2d733 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 6c6fcbc55d3..97e58946bda 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