From 88be91ab2f6a798c295e64a368bcfd95a7c7ad21 Mon Sep 17 00:00:00 2001
From: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
Date: Tue, 9 Jul 2013 05:38:12 +0200
Subject: [PATCH] In MAKE-CONDITION, report names of missing condition classes
 properly

MAKE-CONDITION used to rebind the variable containing the name of the
requested condition class to the condition classoid and thus NIL when
the classoid was not found.

Fixes lp#1199223.
---
 NEWS                      |    2 ++
 src/code/condition.lisp   |   14 +++++++-------
 tests/condition.pure.lisp |   11 +++++++++++
 3 files changed, 20 insertions(+), 7 deletions(-)

diff --git a/NEWS b/NEWS
index e4dc0a9..3ef5958 100644
--- a/NEWS
+++ b/NEWS
@@ -3,6 +3,8 @@ changes relative to sbcl-1.1.9:
   * enhancement: ASDF has been updated to 3.0.2.
   * bug fix: Compiling potential modularic arithmetic forms does not cause type
     errors when some integer types lack lower or upper bounds. (lp#1199127)
+  * bug fix: MAKE-CONDITION reports names of missing condition classes
+    properly (lp#1199223)
 
 changes in sbcl-1.1.9 relative to sbcl-1.1.8:
   * new feature: the contrib SB-GMP links with libgmp at runtime to speed
diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 0c4d22d..d6a807c 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -237,17 +237,17 @@
 ;;;; MAKE-CONDITION
 
 (defun allocate-condition (type &rest initargs)
-  (let* ((type (if (symbolp type)
-                   (find-classoid type nil)
-                   type))
-         (class (typecase type
-                  (condition-classoid type)
+  (let* ((classoid (if (symbolp type)
+                       (find-classoid type nil)
+                       type))
+         (class (typecase classoid
+                  (condition-classoid classoid)
                   (class
                    (return-from allocate-condition
-                     (apply #'allocate-condition (class-name type) initargs)))
+                     (apply #'allocate-condition (class-name classoid) initargs)))
                   (classoid
                    (error 'simple-type-error
-                          :datum type
+                          :datum classoid
                           :expected-type 'condition-class
                           :format-control "~S is not a condition class."
                           :format-arguments (list type)))
diff --git a/tests/condition.pure.lisp b/tests/condition.pure.lisp
index 181b201..03de1a0 100644
--- a/tests/condition.pure.lisp
+++ b/tests/condition.pure.lisp
@@ -196,3 +196,14 @@
 (with-test (:name (:print-undefined-function-condition))
   (handler-case (funcall '#:foo)
     (undefined-function (c) (princ c))))
+
+;; When called with a symbol not designating a condition class,
+;; MAKE-CONDITION used to signal an error which printed as "NIL does
+;; not designate a condition class.".
+(with-test (:name (make-condition :correct-error-for-undefined-condition
+                                  :bug-1199223))
+  (handler-case
+      (make-condition 'no-such-condition)
+    (error (condition)
+      (assert (search (string 'no-such-condition)
+                      (princ-to-string condition))))))
-- 
1.7.10.4