0.8alpha.0.23:

	Fix a couple of the CLOS bugs that have been accumulating:
	... make :ALLOCATION :CLASS slots behave as they should in slot
		inheritance and class redefinition.
	Slightly unKLUDGEify the %SET-SYMBOL-VALUE implementation
	... do it the same way whether building with #!+SB-THREAD or
		not, so at least it's ugly once and only once.

diff --git a/NEWS b/NEWS
index acf60de..ba73d33 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1724,6 +1724,9 @@ changes in sbcl-0.8.0 relative to sbcl-0.8alpha.0
        types.
     ** &ENVIRONMENT parameter in macro lambda list is bound first.
     ** SXHASH on condition objects no longer returns NIL.
+    ** :ALLOCATION :CLASS slots are better treated; their values are
+       updated on class redefinition, and initforms inherited from
+       superclasses are applied.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp
index ff6ae86..5228849 100644 (file)
--- a/src/compiler/generic/objdef.lisp
+++ b/src/compiler/generic/objdef.lisp
@@ -326,8 +326,7 @@
   ;; subtract 3 from (sb-kernel:get-lisp-obj-address 'NIL) you get the
   ;; first data slot, and if you subtract 7 you get a symbol header.
 
-  (value #!-sb-thread :set-trans #!-sb-thread %set-symbol-value
-        :init :unbound)                ;also the CAR of NIL-as-end-of-list
+  (value :init :unbound)               ;also the CAR of NIL-as-end-of-list
   (hash)                               ;the CDR of NIL-as-end-of-list
 
   (plist :ref-trans symbol-plist

diff --git a/src/compiler/generic/vm-ir2tran.lisp b/src/compiler/generic/vm-ir2tran.lisp
index 0125c4a..5cbeb85 100644 (file)
--- a/src/compiler/generic/vm-ir2tran.lisp
+++ b/src/compiler/generic/vm-ir2tran.lisp
@@ -82,11 +82,11 @@
     (do-inits node block name result lowtag inits args)
     (move-continuation-result node block locs cont)))
 
-;;; KLUDGE: this is set up automatically in #!-SB-THREAD builds by the
-;;; :SET-TRANS thing in objdef.lisp.  However, for #!+SB-THREAD builds
-;;; we need to use a special VOP, so we have to do this by hand.
-;;; -- CSR, 2003-05-08
-#!+sb-thread
+;;; :SET-TRANS (in objdef.lisp DEFINE-PRIMITIVE-OBJECT) doesn't quite
+;;; cut it for symbols, where under certain compilation options
+;;; (e.g. #!+SB-THREAD) we have to do something complicated, rather
+;;; than simply set the slot.  So we build the IR2 converting function
+;;; by hand.  -- CSR, 2003-05-08
 (let ((fun-info (fun-info-or-lose '%set-symbol-value)))
   (setf (fun-info-ir2-convert fun-info)
        (lambda (node block)

diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index d943fb8..a653842 100644 (file)
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -499,6 +499,9 @@
       (setq direct-default-initargs
            (plist-value class 'direct-default-initargs)))
   (setf (plist-value class 'class-slot-cells)
+       ;; The below initializes shared slots from direct initforms,
+       ;; but one might inherit initforms from superclasses
+       ;; (cf. UPDATE-SHARED-SLOT-VALUES).
        (let (collect)
          (dolist (dslotd direct-slots)
            (when (eq :class (slot-definition-allocation dslotd))
@@ -826,13 +829,27 @@
     (update-slots class (compute-slots class))
     (update-gfs-of-class class)
     (update-inits class (compute-default-initargs class))
+    (update-shared-slot-values class)
     (update-ctors 'finalize-inheritance :class class))
   (unless finalizep
     (dolist (sub (class-direct-subclasses class)) (update-class sub nil))))
 
+(defun update-shared-slot-values (class)
+  (dolist (slot (class-slots class))
+    (when (eq (slot-definition-allocation slot) :class)
+      (let ((cell (assq (slot-definition-name slot) (class-slot-cells class))))
+        (when cell
+          (let ((initfn (slot-definition-initfunction slot)))
+            (when initfn
+              (setf (cdr cell) (funcall initfn)))))))))
+
 (defun update-cpl (class cpl)
   (if (class-finalized-p class)
-      (unless (equal (class-precedence-list class) cpl)
+      (unless (and (equal (class-precedence-list class) cpl)
+                  (dolist (c cpl t)
+                    (when (position :class (class-direct-slots c)
+                                    :key #'slot-definition-allocation)
+                      (return nil))))
        ;; comment from the old CMU CL sources:
        ;;   Need to have the cpl setup before update-lisp-class-layout
        ;;   is called on CMU CL.

diff --git a/version.lisp-expr b/version.lisp-expr
index e451eef..cfc4544 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.22"
+"0.8alpha.0.23"