0.7.8.38:

	Apply Gerd Moellmann's patch for UPDATE-CLASS /
		FINALIZE-INHERITANCE problems (as reported on cmucl-imp
		by Kevin Rosenberg 2002-10-14)
	... and add some more MOP tests
	(see Entomotomy bug
	finalize-instance-not-being-called-on-class-finalization)

diff --git a/NEWS b/NEWS
index 6c65e6a..c76e8d3 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1311,8 +1311,12 @@ changes in sbcl-0.7.9 relative to sbcl-0.7.8:
   * fixed bug 142: The FFI conversion of C string values to Lisp
     string values no longer conses excessively. (thanks to Nathan
     Froyd porting Raymond Toy's fix to CMU CL)
-  * improved MOP conformance in PCL (thanks to Nathan Froyd porting
-    Gerd Moellman's work in CMU CL)
+  * began to systematize and improve MOP conformance in PCL (thanks to
+    Nathan Froyd, Gerd Moellman and Pierre Mai):
+    ** SLOT-DEFINITION-ALLOCATION now returns :CLASS, not the class
+       itself;
+    ** GENERIC-FUNCTION-ARGUMENT-PRECEDENCE-ORDER is now implemented;
+    ** FINALIZE-INHERITANCE is now called on class finalization.
   * fixed bug 202: The compiler no longer fails on functions whose
     derived types contradict their declared type.
   * DEFMACRO is implemented via EVAL-WHEN instead of IR1 translation,

diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index ed9995e..7b4c293 100644 (file)
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -676,9 +676,24 @@
 ;;; This is called by :after shared-initialize whenever a class is initialized
 ;;; or reinitialized. The class may or may not be finalized.
 (defun update-class (class finalizep)
+  ;; Comment from Gerd Moellmann:
+  ;;
+  ;; Note that we can't simply delay the finalization when CLASS has
+  ;; no forward referenced superclasses because that causes bootstrap
+  ;; problems.
+  (when (and (not finalizep)
+            (not (class-finalized-p class))
+            (not (class-has-a-forward-referenced-superclass-p class)))
+    (finalize-inheritance class)
+    (return-from update-class))
   (when (or finalizep (class-finalized-p class)
            (not (class-has-a-forward-referenced-superclass-p class)))
     (update-cpl class (compute-class-precedence-list class))
+    ;; This invocation of UPDATE-SLOTS, in practice, finalizes the
+    ;; class.  The hoops above are to ensure that FINALIZE-INHERITANCE
+    ;; is called at finalization, so that MOP programmers can hook
+    ;; into the system as described in "Class Finalization Protocol"
+    ;; (section 5.5.2 of AMOP).
     (update-slots class (compute-slots class))
     (update-gfs-of-class class)
     (update-inits class (compute-default-initargs class))

diff --git a/tests/mop.impure.lisp b/tests/mop.impure.lisp
index 6c81e86..5b65f1c 100644 (file)
--- a/tests/mop.impure.lisp
+++ b/tests/mop.impure.lisp
@@ -21,7 +21,8 @@
   (:use "CL"))
 
 (in-package "MOP-TEST")
-
+\f
+;;; Readers for Generic Function Metaobjects (pp. 216--218 of AMOP)
 (defgeneric fn-with-odd-arg-precedence (a b c)
   (:argument-precedence-order b c a))
 
@@ -45,5 +46,37 @@ currently, better put in a quick test in the hope that we can fix it soon:
           (list (nth ll 1) (nth ll 0)))))
 ||#
 \f
+;;; Readers for Slot Definition Metaobjects (pp. 221--224 of AMOP)
+
+;;; Ensure that SLOT-DEFINITION-ALLOCATION returns :INSTANCE/:CLASS as
+;;; appropriate.
+(defclass sdm-test-class ()
+  ((an-instance-slot :accessor an-instance-slot)
+   (a-class-slot :allocation :class :accessor a-class-slot)))
+(dolist (m (list (list #'an-instance-slot :instance)
+                (list #'a-class-slot :class)))
+  (let ((methods (sb-pcl:generic-function-methods (car m))))
+    (assert (= (length methods) 1))
+    (assert (eq (sb-pcl:slot-definition-allocation
+                (sb-pcl:accessor-method-slot-definition
+                 (car methods)))
+               (cadr m)))))
+\f
+;;; Class Finalization Protocol (see section 5.5.2 of AMOP)
+(let ((finalized-count 0))
+  (defmethod sb-pcl:finalize-inheritance :after ((x sb-pcl::standard-class))
+    (incf finalized-count))
+  (defun get-count () finalized-count))
+(defclass finalization-test-1 () ())
+(make-instance 'finalization-test-1)
+(assert (= (get-count) 1))
+(defclass finalization-test-2 (finalization-test-3) ())
+(assert (= (get-count) 1))
+(defclass finalization-test-3 () ())
+(make-instance 'finalization-test-3)
+(assert (or (= (get-count) 2) (= (get-count) 3)))
+(make-instance 'finalization-test-2)
+(assert (= (get-count) 3))
+\f
 ;;;; success
 (sb-ext:quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index 3a3b87d..986b2c4 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.8.37"
+"0.7.8.38"