0.8alpha.0.40:

	Firefighting the build, part I
	... make SLOT-VALUE work on :READ-ONLY T structure slots
	Notes:

	* This version may have a subtle breakage that may or may not
	bite.  The forthcoming 0.8alpha.0.41 commit will fix that
	subtle breakage, but it was fixed chronologically before in my
	tree, so I haven't taken out that fix to test this one in
	isolation.  I hope that makes sense...)

	* The new implementation of MAKE-LOAD-FORM-SAVING-SLOTS seems
	very slow; this may be a perceptual problem.  What is
	incontrovertible is that it is very noisy; it chatters about
	compiling many top-level forms, caused by PCL generating
	LOAD-TIME-VALUE forms for ENSURE-ACCESSOR to optimize SLOT-VALUE.
	A fix for this, at least for structure objects, will probably be
	forthcoming in 0.8alpha.0.4x.

diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp
index e236279..ca1b434 100644 (file)
--- a/src/pcl/braid.lisp
+++ b/src/pcl/braid.lisp
@@ -564,7 +564,7 @@
                 `(:internal-reader-function
                   ,(structure-slotd-reader-function slotd)
                   :internal-writer-function
-                  ,(structure-slotd-writer-function slotd)))
+                  ,(structure-slotd-writer-function name slotd)))
             :type ,(or (structure-slotd-type slotd) t)
             :initform ,(structure-slotd-init-form slotd)
             :initfunction ,(eval-form (structure-slotd-init-form slotd)))))

diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp
index 34537ac..eeeeec4 100644 (file)
--- a/src/pcl/low.lisp
+++ b/src/pcl/low.lisp
@@ -351,9 +351,11 @@
 (defun structure-slotd-reader-function (slotd)
   (fdefinition (dsd-accessor-name slotd)))
 
-(defun structure-slotd-writer-function (slotd)
-  (unless (dsd-read-only slotd)
-    (fdefinition `(setf ,(dsd-accessor-name slotd)))))
+(defun structure-slotd-writer-function (type slotd)
+  (if (dsd-read-only slotd)
+      (let ((dd (get-structure-dd type)))
+       (coerce (sb-kernel::slot-setter-lambda-form dd slotd) 'function))
+      (fdefinition `(setf ,(dsd-accessor-name slotd)))))
 
 (defun structure-slotd-type (slotd)
   (dsd-type slotd))

diff --git a/tests/dump.impure-cload.lisp b/tests/dump.impure-cload.lisp
index a9d77e7..2b1ad11 100644 (file)
--- a/tests/dump.impure-cload.lisp
+++ b/tests/dump.impure-cload.lisp
@@ -71,5 +71,23 @@
 (defparameter *numbers*
   '(-1s0 -1f0 -1d0 -1l0
     #c(-1s0 -1s0) #c(-1f0 -1f0) #c(-1d0 -1d0) #c(-1l0 -1l0)))
-
+\f
+;;; tests for MAKE-LOAD-FORM-SAVING-SLOTS
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defstruct savable-structure
+    (a nil :type symbol)
+    (b nil :type symbol :read-only t)
+    (c nil :read-only t)
+    (d 0 :type fixnum)
+    (e 17 :type (unsigned-byte 32) :read-only t))
+  (defmethod make-load-form ((s savable-structure) &optional env)
+    (make-load-form-saving-slots s :environment env)))
+(defparameter *savable-structure*
+  #.(make-savable-structure :a t :b 'frob :c 1 :d 39 :e 19))
+(assert (eql (savable-structure-a *savable-structure*) t))
+(assert (eql (savable-structure-b *savable-structure*) 'frob))
+(assert (eql (savable-structure-c *savable-structure*) 1))
+(assert (eql (savable-structure-d *savable-structure*) 39))
+(assert (eql (savable-structure-e *savable-structure*) 19))
+\f
 (sb-ext:quit :unix-status 104) ; success

diff --git a/version.lisp-expr b/version.lisp-expr
index 077543b..c86943d 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8alpha.0.39"
+"0.8alpha.0.40"