From 69968cef67fa95f22996c0c8784be8cae63099bb Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 15 Nov 2013 09:01:41 +0000 Subject: [PATCH] relax restriction on defstruct slot names DEFSTRUCT slot names are a bit weird, but behave basically like strings rather than like symbols. This makes their interaction with the MOP a little problematic, but for now simply allow things to pass through and generally work "as expected". Report from Eric Marsden sbcl-devel 2013-11-05 --- doc/manual/beyond-ansi.texinfo | 15 ++++++++++++++- src/pcl/init.lisp | 7 ++++++- tests/defstruct.impure.lisp | 7 ++++++- 3 files changed, 26 insertions(+), 3 deletions(-) diff --git a/doc/manual/beyond-ansi.texinfo b/doc/manual/beyond-ansi.texinfo index 9825343..977e583 100644 --- a/doc/manual/beyond-ansi.texinfo +++ b/doc/manual/beyond-ansi.texinfo @@ -309,6 +309,19 @@ however, it is not consistent with the weaker requirement in AMOP, which states that any class found by @code{find-class}, no matter what its @code{class-name}, is redefined. +@item +@findex @sbmop{slot-definition-name} +@tindex @cl{structure-class} +@findex @cl{defstruct} +an error is not signaled in the case of the @code{:name} initialization +argument for @code{slot-definition} objects being a constant, when the +slot definition is of type @code{structure-slot-definition} (i.e. it is +associated with a class of type @code{structure-class}). + +This allows code which uses constant names for structure slots to +continue working as specified in ANSI, while enforcing the constraint +for all other types of slot. + @end itemize @subsection Metaobject Protocol Extensions @@ -386,7 +399,7 @@ at @findex @cl{find} @findex @cl{subseq} -Users of this extension just make instances of @cl{sequence} subclasses +Users of this extension just make instances of @code{sequence} subclasses and transparently operate on them using sequence functions: @lisp (coerce (subseq (make-instance 'my-sequence) 5 10) 'list) diff --git a/src/pcl/init.lisp b/src/pcl/init.lisp index 6b0c91a..14475ea 100644 --- a/src/pcl/init.lisp +++ b/src/pcl/init.lisp @@ -141,7 +141,12 @@ (error 'slotd-initialization-error :initarg :name :kind :missing)) (unless (symbolp name) (error 'slotd-initialization-type-error :initarg :name :datum name :expected-type 'symbol)) - (when (constantp name) + (when (and (constantp name) + ;; KLUDGE: names of structure slots are weird, and their + ;; weird behaviour gets grandfathered in this way. (The + ;; negative constraint is hard to express in normal + ;; CLOS method terms). + (not (typep slotd 'structure-slot-definition))) (error 'slotd-initialization-error :initarg :name :kind :constant :value name)) (when (and initformp (not initfunp)) (error 'slotd-initialization-error :initarg :initfunction :kind :missing)) diff --git a/tests/defstruct.impure.lisp b/tests/defstruct.impure.lisp index 9bfc78c..08b27d9 100644 --- a/tests/defstruct.impure.lisp +++ b/tests/defstruct.impure.lisp @@ -1141,7 +1141,7 @@ redefinition." (let ((sb-ext:*evaluator-mode* :compile)) (handler-bind ((warning #'error)) (eval `(let () - (defstruct destruct-no-warning-not-at-toplevel bar)))))) + (defstruct defstruct-no-warning-not-at-toplevel bar)))))) (with-test (:name :bug-941102) (let ((test `((defstruct bug-941102) @@ -1153,3 +1153,8 @@ redefinition." (multiple-value-bind (warn2 fail2) (ctu:file-compile test) (assert (not warn2)) (assert (not fail2))))) + +(with-test (:name (defstruct :constant-slot-names)) + (defstruct defstruct-constant-slot-names t) + (assert (= 3 (defstruct-constant-slot-names-t + (make-defstruct-constant-slot-names :t 3))))) -- 1.7.10.4