mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-26 07:11:34 -08:00
Prevent name clashes between CL structures and builtin types
* lisp/emacs-lisp/cl-preloaded.el (cl-struct-define): Don't allow structures with the same names as builtin types. (cl--typeof-types, cl--all-builtin-types): Move from cl-generic.el and rename. (cl--struct-name-p): New helper function. * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Don't allow structures with the same names as builtin types. * lisp/emacs-lisp/cl-generic.el (cl--generic-typeof-generalizer) (cl-generic-generalizers): Adapt to name change. * test/lisp/emacs-lisp/cl-macs-tests.el (cl-defstruct/builtin-type): * test/lisp/emacs-lisp/cl-preloaded-tests.el (cl-struct-define/builtin-type): New unit tests. * etc/NEWS: Document changed behavior.
This commit is contained in:
parent
a718e1593a
commit
9a747b3554
6 changed files with 84 additions and 30 deletions
|
|
@ -1160,45 +1160,19 @@ These match if the argument is `eql' to VAL."
|
|||
|
||||
;;; Dispatch on "system types".
|
||||
|
||||
(defconst cl--generic-typeof-types
|
||||
;; Hand made from the source code of `type-of'.
|
||||
'((integer number number-or-marker atom)
|
||||
(symbol atom) (string array sequence atom)
|
||||
(cons list sequence)
|
||||
;; Markers aren't `numberp', yet they are accepted wherever integers are
|
||||
;; accepted, pretty much.
|
||||
(marker number-or-marker atom)
|
||||
(overlay atom) (float number atom) (window-configuration atom)
|
||||
(process atom) (window atom) (subr atom) (compiled-function function atom)
|
||||
(buffer atom) (char-table array sequence atom)
|
||||
(bool-vector array sequence atom)
|
||||
(frame atom) (hash-table atom) (terminal atom)
|
||||
(thread atom) (mutex atom) (condvar atom)
|
||||
(font-spec atom) (font-entity atom) (font-object atom)
|
||||
(vector array sequence atom)
|
||||
;; Plus, really hand made:
|
||||
(null symbol list sequence atom))
|
||||
"Alist of supertypes.
|
||||
Each element has the form (TYPE . SUPERTYPES) where TYPE is one of
|
||||
the symbols returned by `type-of', and SUPERTYPES is the list of its
|
||||
supertypes from the most specific to least specific.")
|
||||
|
||||
(defconst cl--generic-all-builtin-types
|
||||
(delete-dups (copy-sequence (apply #'append cl--generic-typeof-types))))
|
||||
|
||||
(cl-generic-define-generalizer cl--generic-typeof-generalizer
|
||||
;; FIXME: We could also change `type-of' to return `null' for nil.
|
||||
10 (lambda (name &rest _) `(if ,name (type-of ,name) 'null))
|
||||
(lambda (tag &rest _)
|
||||
(and (symbolp tag) (assq tag cl--generic-typeof-types))))
|
||||
(and (symbolp tag) (assq tag cl--typeof-types))))
|
||||
|
||||
(cl-defmethod cl-generic-generalizers :extra "typeof" (type)
|
||||
"Support for dispatch on builtin types.
|
||||
See the full list and their hierarchy in `cl--generic-typeof-types'."
|
||||
See the full list and their hierarchy in `cl--typeof-types'."
|
||||
;; FIXME: Add support for other types accepted by `cl-typep' such
|
||||
;; as `character', `face', `function', ...
|
||||
(or
|
||||
(and (memq type cl--generic-all-builtin-types)
|
||||
(and (memq type cl--all-builtin-types)
|
||||
(progn
|
||||
;; FIXME: While this wrinkle in the semantics can be occasionally
|
||||
;; problematic, this warning is more often annoying than helpful.
|
||||
|
|
|
|||
|
|
@ -2687,6 +2687,9 @@ non-nil value, that slot cannot be set via `setf'.
|
|||
(forms nil)
|
||||
(docstring (if (stringp (car descs)) (pop descs)))
|
||||
pred-form pred-check)
|
||||
;; Can't use `cl-check-type' yet.
|
||||
(unless (cl--struct-name-p name)
|
||||
(signal 'wrong-type-argument (list 'cl-struct-name-p name 'name)))
|
||||
(setq descs (cons '(cl-tag-slot)
|
||||
(mapcar (function (lambda (x) (if (consp x) x (list x))))
|
||||
descs)))
|
||||
|
|
|
|||
|
|
@ -50,6 +50,37 @@
|
|||
(apply #'error string (append sargs args))
|
||||
(signal 'cl-assertion-failed `(,form ,@sargs)))))
|
||||
|
||||
(defconst cl--typeof-types
|
||||
;; Hand made from the source code of `type-of'.
|
||||
'((integer number number-or-marker atom)
|
||||
(symbol atom) (string array sequence atom)
|
||||
(cons list sequence)
|
||||
;; Markers aren't `numberp', yet they are accepted wherever integers are
|
||||
;; accepted, pretty much.
|
||||
(marker number-or-marker atom)
|
||||
(overlay atom) (float number atom) (window-configuration atom)
|
||||
(process atom) (window atom) (subr atom) (compiled-function function atom)
|
||||
(buffer atom) (char-table array sequence atom)
|
||||
(bool-vector array sequence atom)
|
||||
(frame atom) (hash-table atom) (terminal atom)
|
||||
(thread atom) (mutex atom) (condvar atom)
|
||||
(font-spec atom) (font-entity atom) (font-object atom)
|
||||
(vector array sequence atom)
|
||||
;; Plus, really hand made:
|
||||
(null symbol list sequence atom))
|
||||
"Alist of supertypes.
|
||||
Each element has the form (TYPE . SUPERTYPES) where TYPE is one of
|
||||
the symbols returned by `type-of', and SUPERTYPES is the list of its
|
||||
supertypes from the most specific to least specific.")
|
||||
|
||||
(defconst cl--all-builtin-types
|
||||
(delete-dups (copy-sequence (apply #'append cl--typeof-types))))
|
||||
|
||||
(defun cl--struct-name-p (name)
|
||||
"Return t if NAME is a valid structure name for `cl-defstruct'."
|
||||
(and name (symbolp name) (not (keywordp name))
|
||||
(not (memq name cl--all-builtin-types))))
|
||||
|
||||
;; When we load this (compiled) file during pre-loading, the cl--struct-class
|
||||
;; code below will need to access the `cl-struct' info, since it's considered
|
||||
;; already as its parent (because `cl-struct' was defined while the file was
|
||||
|
|
@ -110,6 +141,7 @@
|
|||
;;;###autoload
|
||||
(defun cl-struct-define (name docstring parent type named slots children-sym
|
||||
tag print)
|
||||
(cl-check-type name cl--struct-name)
|
||||
(unless type
|
||||
;; Legacy defstruct, using tagged vectors. Enable backward compatibility.
|
||||
(cl-old-struct-compat-mode 1))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue