From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 17 May 2004 07:58:42 +0000 (+0000)
Subject: 0.8.10.26:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=2f1071f50ae43bce938aacf03d67d9626014a076;p=sbcl.git

0.8.10.26:
         Fixed bug 320: Shared to local slot value transfers from superclasses
         in class redefinitions.
         ... Made OBSOLETE-INSTANCE-TRAP grovel over the inherited class
                slots as well.
---

diff --git a/BUGS b/BUGS
index 4535ebf..175889a 100644
--- a/BUGS
+++ b/BUGS
@@ -1407,24 +1407,6 @@ WORKAROUND:
     #(1 2 ((SB-IMPL::|,|) + 2 2) 4)
   which probably isn't intentional.
 
-320: "shared to local slot in class redefinition"
-  reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP
-  test suite.
-    ;; Shared slot becomes local.
-    ;; 4.3.6.1.: "The value of a slot that is specified as shared in
-    ;; the old class and as local in the new class is retained."
-    (multiple-value-bind (value condition)
-        (ignore-errors
-          (defclass foo85a () 
-            ((size :initarg :size :initform 1 :allocation :class)))
-          (defclass foo85b (foo85a) ())
-          (setq i (make-instance 'foo85b))
-          (defclass foo85a () ((size :initarg :size :initform 2) (other)))
-          (slot-value i 'size))
-      (list value (type-of condition)))
-  should return (1 NULL) but returns (2 NULL) in sbcl-0.8.10.  See
-  ensuing discussion sbcl-devel for how to deal with this.
-
 321: "DEFINE-METHOD-COMBINATION lambda list parsing"
   reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP
   test suite.
diff --git a/NEWS b/NEWS
index 8c81f3e..e167b0b 100644
--- a/NEWS
+++ b/NEWS
@@ -2398,6 +2398,9 @@ changes in sbcl-0.8.10 relative to sbcl-0.8.9:
        to Bruno Haible)
 
 changes in sbcl-0.8.11 relative to sbcl-0.8.10:
+  * fixed bug 320: Shared to local slot value transfers in class 
+    redefinitions now happen corrently from superclasses as
+    well. (reported by Bruno Haible)
   * fixed bug 316: SHIFTF now accepts VALUES forms. (reported by Bruno
     Haible)
   * fixed bug 322: DEFSTRUCT :TYPE LIST type predicates now handle
diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp
index 007acfe..766e7e7 100644
--- a/src/pcl/cache.lisp
+++ b/src/pcl/cache.lisp
@@ -204,6 +204,7 @@
 (defmacro wrapper-no-of-instance-slots (wrapper)
   `(layout-length ,wrapper))
 
+;;; FIXME: Why are these macros?
 (defmacro wrapper-instance-slots-layout (wrapper)
   `(%wrapper-instance-slots-layout ,wrapper))
 (defmacro wrapper-class-slots (wrapper)
diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index d03f94e..2e2464f 100644
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -1380,6 +1380,7 @@
 	     (added ())
 	     (discarded ())
 	     (plist ()))
+
 	;; local  --> local	transfer value
 	;; local  --> shared    discard value, discard slot
 	;; local  -->  --	discard slot
@@ -1389,6 +1390,15 @@
 	;;  --    --> local	add slot
 	;;  --    --> shared	--
 
+	;; Collect class slots from inherited wrappers. Needed for
+	;; shared -> local transfers of inherited slots.
+	(let ((inherited (layout-inherits owrapper)))
+	  (loop for i from (1- (length inherited)) downto 0
+		for layout = (aref inherited i)
+		when (typep layout 'wrapper)
+		do (dolist (slot (wrapper-class-slots layout))
+		     (pushnew slot oclass-slots :key #'car))))
+
 	;; Go through all the old local slots.
         (let ((opos 0))
           (dolist (name olayout)
diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index 25358d4..d8d5946 100644
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -766,5 +766,16 @@
 (slot-boundp *obsoleted* 'a)
 (assert (= *obsoleted-counter* 1))
 
+;;; shared -> local slot transfers of inherited slots, reported by
+;;; Bruno Haible
+(let (i)
+  (defclass super-with-magic-slot () 
+    ((magic :initarg :size :initform 1 :allocation :class)))
+  (defclass sub-of-super-with-magic-slot (super-with-magic-slot) ())
+  (setq i (make-instance 'sub-of-super-with-magic-slot))
+  (defclass super-with-magic-slot () 
+    ((magic :initarg :size :initform 2)))
+  (assert (= 1 (slot-value i 'magic))))
+
 ;;;; success
 (sb-ext:quit :unix-status 104)
diff --git a/version.lisp-expr b/version.lisp-expr
index 9f01424..8d2719b 100644
--- 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.25"
+"0.8.10.26"