0.8.10.32:

         Fixed ansi-test DEFCLASS-0211.1 (broken in compiled code only):
         ... SB-PCL::COMPUTE-SLOTS :AROUND now checks if initfuntions exist
                for unbound slots, and uses them to initialize. Similar task
                used to be done by the bygone SB-PCL::UPDATE-SHARED-SLOT-VALUES.
                This is hopefully more correct.
         ... Renamed SB-PCL::UPDATE-INITS to SB-PCL::UPDATE-INITARGS for
                clarity.
         ... Test case added.

diff --git a/NEWS b/NEWS
index 870970d..29710b5 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2445,6 +2445,8 @@ changes in sbcl-0.8.11 relative to sbcl-0.8.10:
     :LOAD-TOPLEVEL context; this appears to decrease fasl sizes by
     approximately 10%.
   * fixed some bugs revealed by Paul Dietz' test suite:
+    ** Fixed an optimization bug related to inheritance of initforms
+       from local to shared slots.
     ** FILE-POSITION works as specified on BROADCAST-STREAMs.
     ** CAST optimizer forgot to flush argument derived type.
     ** print/read consistency on floats is now orders of magnitude

diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index 2e2464f..a6cec9d 100644 (file)
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -869,7 +869,7 @@
     ;; (section 5.5.2 of AMOP).
     (update-slots class (compute-slots class))
     (update-gfs-of-class class)
-    (update-inits class (compute-default-initargs class))
+    (update-initargs class (compute-default-initargs class))
     (update-ctors 'finalize-inheritance :class class))
   (unless finalizep
     (dolist (sub (class-direct-subclasses class)) (update-class sub nil))))
@@ -975,7 +975,7 @@
                   (update-gf-dfun class gf))
                 gf-table)))))
 
-(defun update-inits (class inits)
+(defun update-initargs (class inits)
   (setf (plist-value class 'default-initargs) inits))
 \f
 (defmethod compute-default-initargs ((class slot-class))
@@ -1030,7 +1030,13 @@
                      (from-class (slot-definition-allocation-class eslotd))
                      (cell (assq name (class-slot-cells from-class))))
                 (aver (consp cell))
-                cell))))
+                (if (eq +slot-unbound+ (cdr cell))
+                    ;; We may have inherited an initfunction
+                    (let ((initfun (slot-definition-initfunction eslotd)))
+                      (if initfun
+                          (rplacd cell (funcall initfun))
+                          cell))
+                    cell)))))
       (initialize-internal-slot-functions eslotd))))
 
 (defmethod compute-slots ((class funcallable-standard-class))

diff --git a/tests/clos.impure-cload.lisp b/tests/clos.impure-cload.lisp
index d866200..67032c5 100644 (file)
--- a/tests/clos.impure-cload.lisp
+++ b/tests/clos.impure-cload.lisp
@@ -94,6 +94,16 @@
 (assert (= (slot-value (make-instance 'definitargs-class) 'a) 1))
 (assert (= (slot-value (make-instance 'definitargs-class :a 0) 'a) 0))
 (assert (= *definitargs-counter* 2))
+
+;;; inherited local -> shared slot initforms
+;;  (adapted from Paul F. Dietz's test suite DEFCLASS-0211.1)
+(defclass shared-to-local-initform-super ()
+  ((redefined :allocation :instance :initform 'orig-initform)))
+(defclass shared-to-local-initform-sub (shared-to-local-initform-super)
+  ((redefined :allocation :class)))
+(assert (slot-boundp (make-instance 'shared-to-local-initform-sub) 'redefined))
+(assert (eq 'orig-initform
+           (slot-value (make-instance 'shared-to-local-initform-sub) 'redefined)))
 \f
 ;;; success
 (sb-ext:quit :unix-status 104)
\ No newline at end of file

diff --git a/version.lisp-expr b/version.lisp-expr
index 676fef9..3b39ef3 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.8.10.31"
+"0.8.10.32"