0.8alpha.0.25:

	A couple of PCL fixes:
	... REMOVE-METHOD should always return its generic function
		argument.  Make it so.
	... SHARED-INITIALIZE should initialize :CLASS slots too.

diff --git a/NEWS b/NEWS
index ba73d33..5a501fd 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1727,6 +1727,10 @@ changes in sbcl-0.8.0 relative to sbcl-0.8alpha.0
     ** :ALLOCATION :CLASS slots are better treated; their values are
        updated on class redefinition, and initforms inherited from
        superclasses are applied.
+    ** REMOVE-METHOD returns its generic function argument even when
+       no method was removed.
+    ** SHARED-INITIALIZE now initializes the values of the requested
+       slots, including those with :ALLOCATION :CLASS.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/pcl/init.lisp b/src/pcl/init.lisp
index 2fc6eba..236fc86 100644 (file)
--- a/src/pcl/init.lisp
+++ b/src/pcl/init.lisp
@@ -132,11 +132,15 @@
             (loop for slotd in (class-slots class)
                   unless (initialize-slot-from-initarg class instance slotd)
                     collect slotd)))
-      (loop for slotd in initfn-slotds
-            when (and (not (eq :class (slot-definition-allocation slotd)))
-                      (or (eq t slot-names)
-                          (memq (slot-definition-name slotd) slot-names))) do
-              (initialize-slot-from-initfunction class instance slotd)))
+      (dolist (slotd initfn-slotds)
+       (if (eq (slot-definition-allocation slotd) :class)
+           (when (or (eq t slot-names)
+                     (memq (slot-definition-name slotd) slot-names))
+             (unless (slot-boundp-using-class class instance slotd)
+               (initialize-slot-from-initfunction class instance slotd)))
+           (when (or (eq t slot-names)
+                     (memq (slot-definition-name slotd) slot-names))
+             (initialize-slot-from-initfunction class instance slotd)))))
     instance))
 \f
 ;;; If initargs are valid return nil, otherwise signal an error.

diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp
index 8d0f176..dff22ed 100644 (file)
--- a/src/pcl/methods.lisp
+++ b/src/pcl/methods.lisp
@@ -515,12 +515,11 @@
        method)))
 
 (defun real-remove-method (generic-function method)
-  ;; Note: Error check prohibited by ANSI spec removed.
   (when  (eq generic-function (method-generic-function method))
-    (let* ((name        (generic-function-name generic-function))
+    (let* ((name (generic-function-name generic-function))
           (specializers (method-specializers method))
-          (methods      (generic-function-methods generic-function))
-          (new-methods  (remove method methods)))
+          (methods (generic-function-methods generic-function))
+          (new-methods (remove method methods)))
       (setf (method-generic-function method) nil)
       (setf (generic-function-methods generic-function) new-methods)
       (dolist (specializer (method-specializers method))
@@ -529,8 +528,8 @@
       (update-ctors 'remove-method
                    :generic-function generic-function
                    :method method)
-      (update-dfun generic-function)
-      generic-function)))
+      (update-dfun generic-function)))
+  generic-function)
 \f
 (defun compute-applicable-methods-function (generic-function arguments)
   (values (compute-applicable-methods-using-types

diff --git a/version.lisp-expr b/version.lisp-expr
index 4497f8f..25e32af 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.24"
+"0.8alpha.0.25"