272 |
;;; The above is badly designed, since it fails when some signals |
;;; The above is badly designed, since it fails when some signals |
273 |
;;; may be in more than one class/ |
;;; may be in more than one class/ |
274 |
|
|
275 |
(defmacro signals-error (form error-name &key (safety 3)) |
(defmacro signals-error (form error-name &key (safety 3) name) |
276 |
`(handler-bind |
`(handler-bind |
277 |
((warning #'(lambda (c) (declare (ignore c)) |
((warning #'(lambda (c) (declare (ignore c)) |
278 |
(muffle-warning)))) |
(muffle-warning)))) |
293 |
(type-error-expected-type c)) |
(type-error-expected-type c)) |
294 |
(values |
(values |
295 |
nil |
nil |
296 |
(list (list 'typep (type-error-datum c) |
(list (list 'typep (list 'quote |
297 |
(type-error-expected-type c)) |
(type-error-datum c)) |
298 |
|
(list 'quote |
299 |
|
(type-error-expected-type c))) |
300 |
"==> true")))) |
"==> true")))) |
301 |
nil) |
nil) |
302 |
|
,@(if (eq error-name 'undefined-function) |
303 |
|
`(((not (eq (cell-error-name c) ',name)) |
304 |
|
(values |
305 |
|
nil |
306 |
|
(list 'cell-error-name "==>" |
307 |
|
(cell-error-name c))))) |
308 |
|
nil) |
309 |
(t (printable-p c))))))) |
(t (printable-p c))))))) |
310 |
|
|
311 |
(defmacro signals-error-always (form error-name) |
(defmacro signals-error-always (form error-name) |