From 151496a4b96430924bc148f85b9c8471d1e132b1 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Thu, 21 Dec 2017 18:25:49 +0100 Subject: [PATCH] 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--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. * 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. --- etc/NEWS | 4 +++ lisp/emacs-lisp/cl-macs.el | 4 +++ lisp/emacs-lisp/cl-preloaded.el | 8 ++++++ test/lisp/emacs-lisp/cl-macs-tests.el | 9 ++++++ test/lisp/emacs-lisp/cl-preloaded-tests.el | 33 ++++++++++++++++++++++ 5 files changed, 58 insertions(+) create mode 100644 test/lisp/emacs-lisp/cl-preloaded-tests.el diff --git a/etc/NEWS b/etc/NEWS index c5a4bc3344b..4eb620105ad 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -190,6 +190,10 @@ calling 'eldoc-message' directly. ** Old-style backquotes now generate an error. They have been generating warnings for a decade. +** 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. + * Lisp Changes in Emacs 27.1 diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 16f33282bae..05cb9b091d9 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -43,6 +43,7 @@ ;;; Code: +(require 'cl-generic) (require 'cl-lib) (require 'macroexp) ;; `gv' is required here because cl-macs can be loaded before loaddefs.el. @@ -2663,6 +2664,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))) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 4e73a4a31b7..33a1438f690 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -36,6 +36,7 @@ ;;; Code: +(eval-when-compile (require 'cl-generic)) (eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'cl-macs)) ;For cl--struct-class. @@ -50,6 +51,12 @@ (apply #'error string (append sargs args)) (signal 'cl-assertion-failed `(,form ,@sargs))))) +(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 (eval-when-compile cl--generic-all-builtin-types))) + t)) + ;; 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 +117,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)) diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index f0bde7af397..9236ac73b50 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -497,4 +497,13 @@ collection clause." vconcat (vector (1+ x))) [2 3 4 5 6]))) + +(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 diff --git a/test/lisp/emacs-lisp/cl-preloaded-tests.el b/test/lisp/emacs-lisp/cl-preloaded-tests.el new file mode 100644 index 00000000000..008a6e629f5 --- /dev/null +++ b/test/lisp/emacs-lisp/cl-preloaded-tests.el @@ -0,0 +1,33 @@ +;;; cl-preloaded-tests.el --- unit tests for cl-preloaded.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; Author: Philipp Stephani + +;; 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 . + +;;; 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 -- 2.39.2