[Sbcl-commits] master: relax restriction on defstruct slot names

[Christophe R. <cr...@us...>]

The branch "master" has been updated in SBCL:
       via  69968cef67fa95f22996c0c8784be8cae63099bb (commit)
      from  5eb98a1de601302b0e3eb0c385262fca9093fcc0 (commit)

- Log -----------------------------------------------------------------
commit 69968cef67fa95f22996c0c8784be8cae63099bb
Author: Christophe Rhodes <cs...@ca...>
Date:   Fri Nov 15 09:01:41 2013 +0000

    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)))))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL