X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcondition.lisp;h=81a0ce711e27e21001732717a02d8445a17a4c60;hb=8c6e2e85859766d2c4c6a272b952de2ebe467487;hp=a6ccb128a8b241dfcf54b80f802a3c5878a92bb3;hpb=9c0c32bf94b510ea0f7bed34a91d0ddf3ea909fc;p=sbcl.git diff --git a/src/code/condition.lisp b/src/code/condition.lisp index a6ccb12..81a0ce7 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -446,8 +446,6 @@ (dolist (initarg (condition-slot-initargs slot) nil) (when (functionp (third (assoc initarg e-def-initargs))) (return t)))) - ;; TODO temp - (assert (not (member slot (condition-classoid-hairy-slots class)))) (push slot (condition-classoid-hairy-slots class))))))) (when (boundp '*define-condition-hooks*) (dolist (fun *define-condition-hooks*) @@ -535,7 +533,8 @@ :initform-p ',initform-p :documentation ',documentation :initform ,(when initform-p - `#'(lambda () ,initform))))))) + `#'(lambda () ,initform)) + :allocation ',allocation))))) (dolist (option options) (unless (consp option) @@ -624,7 +623,9 @@ (type-error-expected-type condition))))) (def!method print-object ((condition type-error) stream) - (if *print-escape* + (if (and *print-escape* + (slot-boundp condition 'expected-type) + (slot-boundp condition 'datum)) (flet ((maybe-string (thing) (ignore-errors (write-to-string thing :lines 1 :readably nil :array nil :pretty t))))