0.8.18.3:

[sbcl.git] / src / code / condition.lisp

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 1511705..ecd3766 100644 (file)
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -233,8 +233,7 @@
   "Make an instance of a condition object using the specified initargs."
   ;; Note: ANSI specifies no exceptional situations in this function.
   ;; signalling simple-type-error would not be wrong.
-  (let* ((thing (if (symbolp thing)
-                   (find-classoid thing)
+  (let* ((thing (or (and (symbolp thing) (find-classoid thing nil))
                    thing))
         (class (typecase thing
                  (condition-classoid thing)
@@ -822,7 +821,8 @@
 (def!method print-object :around ((o reference-condition) s)
   (call-next-method)
   (unless (or *print-escape* *print-readably*)
-    (when *print-condition-references*
+    (when (and *print-condition-references*
+               (reference-condition-references o))
       (format s "~&See also:~%")
       (pprint-logical-block (s nil :per-line-prefix "  ")
        (do* ((rs (reference-condition-references o) (cdr rs))
@@ -936,6 +936,12 @@ symbol that caused the violation is accessed by the function
 SB-EXT:PACKAGE-LOCKED-ERROR-SYMBOL."))
 
 ) ; progn
+
+(define-condition undefined-alien-error (error) ()
+  (:report
+   (lambda (condition stream)
+     (declare (ignore condition))
+     (format stream "Attempt to access an undefined alien value."))))
 \f
 ;;;; various other (not specified by ANSI) CONDITIONs
 ;;;;