generating warnings for a decade. To interpret old-style backquotes
as new-style, bind the new variable 'force-new-style-backquotes' to t.
+** Defining a Common Lisp structure using 'cl-defstruct' or
+'cl-struct-define' whose name clashes with a builtin type (e.g.,
+'integer' or 'hash-table') now signals an error.
+
\f
* Lisp Changes in Emacs 27.1
;;; 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.
(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)))
(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
;;;###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))
vconcat (vector (1+ x)))
[2 3 4 5 6])))
-
(ert-deftest cl-macs-loop-for-as-equals-and ()
"Test for https://debbugs.gnu.org/29799 ."
(let ((arr (make-vector 3 0)))
(cl-loop for k below 3 for x = k and z = (elt arr k)
collect (list k x))))))
+\f
+(ert-deftest cl-defstruct/builtin-type ()
+ (should-error
+ (macroexpand '(cl-defstruct hash-table))
+ :type 'wrong-type-argument)
+ (should-error
+ (macroexpand '(cl-defstruct (hash-table (:predicate hash-table-p))))
+ :type 'wrong-type-argument))
+
;;; cl-macs-tests.el ends here
--- /dev/null
+;;; cl-preloaded-tests.el --- unit tests for cl-preloaded.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+;; Author: Philipp Stephani <phst@google.com>
+
+;; This file is part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Unit tests for lisp/emacs-lisp/cl-preloaded.el.
+
+;;; Code:
+
+(ert-deftest cl-struct-define/builtin-type ()
+ (should-error
+ (cl-struct-define 'hash-table nil nil 'record nil nil
+ 'cl-preloaded-tests-tag 'cl-preloaded-tests nil)
+ :type 'wrong-type-argument))
+
+;;; cl-preloaded-tests.el ends here
projects / emacs.git / commitdiff