0.8.12.24: Stomping on a PCL buglet

            * Initialization of condition class metaobjects no longer
                creates an instance of the condition. (reported by
                Marco Baringer on sbcl-devel 2004-07-05)
            * Test for the same.

diff --git a/NEWS b/NEWS
index 730e1d1..a813f36 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -9,6 +9,9 @@ changes in sbcl-0.8.13 relative to sbcl-0.8.12:
     an implementation-internal package.
   * the SB-SPROF contrib now works on (most) non-x86 architectures.
     It is known as of this release not to work on the Alpha, however.
+  * fixed bug: initialization of condition class metaobjects no longer
+    causes an instance of the condition to be created. (reported by Marco
+    Baringer)
   * fixed bug #338: instances of EQL-SPECIFIER are now valid type
     designators and can hence be used with TYPEP.
   * fixed bug #333: CHECK-TYPE now ensures that the type error

diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index 5a86391..382a235 100644 (file)
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -133,6 +133,10 @@
                  (allocate-instance class)
                  (allocate-standard-instance wrapper))))))
 
+(defmethod class-prototype ((class condition-class))
+  (with-slots (prototype) class
+    (or prototype (setf prototype (allocate-instance class)))))
+
 (defmethod class-direct-default-initargs ((class slot-class))
   (plist-value class 'direct-default-initargs))
 
@@ -594,7 +598,6 @@
       (setq direct-supers direct-superclasses)
       (setq wrapper (classoid-layout classoid))
       (setq class-precedence-list (compute-class-precedence-list class))
-      (setq prototype (make-condition (class-name class)))
       (add-direct-subclasses class direct-superclasses)
       (setq predicate-name (make-class-predicate-name (class-name class)))
       (make-class-predicate class predicate-name)

diff --git a/tests/condition.impure.lisp b/tests/condition.impure.lisp
index 03145a7..b454b4b 100644 (file)
--- a/tests/condition.impure.lisp
+++ b/tests/condition.impure.lisp
@@ -37,5 +37,14 @@
   (assert (eql (code-msg code) 2))
   (assert (eql (%code-msg code) 1)))
 
+;;; Check that initializing the condition class metaobject doesn't create
+;;; any instances. Reported by Marco Baringer on sbcl-devel Mon, 05 Jul 2004.
+(defvar *condition-count* 0)
+(define-condition counted-condition () ((slot :initform (incf *condition-count*))))
+(defmethod frob-counted-condition ((x counted-condition)) x)
+(assert (= 0 *condition-count*))
+(assert (typep (sb-mop:class-prototype (find-class 'counted-condition))
+              '(and condition counted-condition)))
+
 ;;; success
 (sb-ext:quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index 5057a74..7f3e3a5 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.12.23"
+"0.8.12.24"