X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcondition.impure.lisp;h=b454b4bf562494675d250b7561c5acf147072361;hb=9b55754d5328a5f44ee224d32865fc8dadee123b;hp=246a6a8336b34318b960ee504df6ed9164dcb825;hpb=784b195743728436795b90f95273c3535ebee9a5;p=sbcl.git

diff --git a/tests/condition.impure.lisp b/tests/condition.impure.lisp
index 246a6a8..b454b4b 100644
--- a/tests/condition.impure.lisp
+++ b/tests/condition.impure.lisp
@@ -36,3 +36,15 @@
   (setf (code-msg code) 2)
   (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)