X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=src%2Fcode%2Fcondition.lisp;h=2015a77a096ba65cc19e8868e4dbdd9534af8695;hb=f37fd916aae6ecbb7341c1385c7113608b7816a5;hp=8c410d459df1b54ef03eb581845f7730e38657c5;hpb=741d910ca6f69a115905872ea84258baba5392c7;p=sbcl.git

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 8c410d4..2015a77 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -398,8 +398,12 @@
 
 (defvar *define-condition-hooks* nil)
 
+(defun %set-condition-report (name report)
+  (setf (condition-classoid-report (find-classoid name))
+        report))
+
 (defun %define-condition (name parent-types layout slots documentation
-                          report default-initargs all-readers all-writers
+                          default-initargs all-readers all-writers
                           source-location)
   (with-single-package-locked-error
       (:symbol name "defining ~A as a condition")
@@ -409,7 +413,6 @@
             source-location))
     (let ((class (find-classoid name)))
       (setf (condition-classoid-slots class) slots)
-      (setf (condition-classoid-report class) report)
       (setf (condition-classoid-default-initargs class) default-initargs)
       (setf (fdocumentation name 'type) documentation)
 
@@ -548,10 +551,10 @@
              (setq report
                    (if (stringp arg)
                        `#'(lambda (condition stream)
-                          (declare (ignore condition))
-                          (write-string ,arg stream))
+                            (declare (ignore condition))
+                            (write-string ,arg stream))
                        `#'(lambda (condition stream)
-                          (funcall #',arg condition stream))))))
+                            (funcall #',arg condition stream))))))
           (:default-initargs
            (do ((initargs (rest option) (cddr initargs)))
                ((endp initargs))
@@ -575,11 +578,15 @@
                               ',layout
                               (list ,@(slots))
                               ,documentation
-                              ,report
                               (list ,@default-initargs)
                               ',(all-readers)
                               ',(all-writers)
-                              (sb!c:source-location)))))))
+                              (sb!c:source-location))
+           ;; This needs to be after %DEFINE-CONDITION in case :REPORT
+           ;; is a lambda referring to condition slot accessors:
+           ;; they're not proclaimed as functions before it has run if
+           ;; we're under EVAL or loaded as source.
+           (%set-condition-report ',name ,report))))))
 
 ;;;; various CONDITIONs specified by ANSI