From 417194ff68d1aa98513945c004d8feb10a11500b Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Mon, 2 May 2005 11:21:02 +0000
Subject: [PATCH] Make the error message when type-error slots don't match more
 transparent.  Add a check for undefined-function cell-error-name

---
 ansi-tests/ansi-aux.lsp | 15 ++++++++++++---
 1 file changed, 12 insertions(+), 3 deletions(-)

diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp
index e7fc5007..d5d7eb1c 100644
--- a/ansi-tests/ansi-aux.lsp
+++ b/ansi-tests/ansi-aux.lsp
@@ -272,7 +272,7 @@ the condition to go uncaught if it cannot be classified."
 ;;; The above is badly designed, since it fails when some signals
 ;;; may be in more than one class/
 
-(defmacro signals-error (form error-name &key (safety 3))
+(defmacro signals-error (form error-name &key (safety 3) name)
   `(handler-bind
     ((warning #'(lambda (c) (declare (ignore c))
 			      (muffle-warning))))
@@ -293,10 +293,19 @@ the condition to go uncaught if it cannot be classified."
 				   (type-error-expected-type c))
 			    (values
 			     nil
-			     (list (list 'typep (type-error-datum c)
-					 (type-error-expected-type c))
+			     (list (list 'typep (list 'quote
+						      (type-error-datum c))
+					 (list 'quote
+					       (type-error-expected-type c)))
 				   "==> true"))))
 		       nil)
+		   ,@(if (eq error-name 'undefined-function)
+			 `(((not (eq (cell-error-name c) ',name))
+			    (values
+			     nil
+			     (list 'cell-error-name "==>"
+				   (cell-error-name c)))))
+		       nil)
 		   (t (printable-p c)))))))
 
 (defmacro signals-error-always (form error-name)
-- 
GitLab