0.8.13.41: Require robustness

[sbcl.git] / src / pcl / std-class.lisp

diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index 5a86391..fdc3ebb 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)
@@ -1037,7 +1040,7 @@
        (location -1))
     (dolist (eslotd eslotds eslotds)
       (setf (slot-definition-location eslotd)
-           (ecase (slot-definition-allocation eslotd)
+           (case (slot-definition-allocation eslotd)
              (:instance
               (incf location))
              (:class
@@ -1099,7 +1102,7 @@
          (instance-slots ())
          (class-slots ()))
       (dolist (slotd all-slotds)
-       (ecase (slot-definition-allocation slotd)
+       (case (slot-definition-allocation slotd)
          (:instance (push slotd instance-slots))
          (:class (push slotd class-slots))))
       (let ((layout (compute-layout instance-slots)))