Skip to content
Snippets Groups Projects
Commit 417194ff authored by pfdietz's avatar pfdietz
Browse files

Make the error message when type-error slots don't match more transparent. ...

Make the error message when type-error slots don't match more transparent.  Add a check for undefined-function cell-error-name
parent 68c42c64
No related branches found
No related tags found
No related merge requests found
...@@ -272,7 +272,7 @@ the condition to go uncaught if it cannot be classified." ...@@ -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 ;;; The above is badly designed, since it fails when some signals
;;; may be in more than one class/ ;;; 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 `(handler-bind
((warning #'(lambda (c) (declare (ignore c)) ((warning #'(lambda (c) (declare (ignore c))
(muffle-warning)))) (muffle-warning))))
...@@ -293,10 +293,19 @@ the condition to go uncaught if it cannot be classified." ...@@ -293,10 +293,19 @@ the condition to go uncaught if it cannot be classified."
(type-error-expected-type c)) (type-error-expected-type c))
(values (values
nil nil
(list (list 'typep (type-error-datum c) (list (list 'typep (list 'quote
(type-error-expected-type c)) (type-error-datum c))
(list 'quote
(type-error-expected-type c)))
"==> true")))) "==> true"))))
nil) 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))))))) (t (printable-p c)))))))
(defmacro signals-error-always (form error-name) (defmacro signals-error-always (form error-name)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment