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