/[gcl]/gcl/ansi-tests/ansi-aux.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/ansi-aux.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.117 by pfdietz, Sun May 1 14:03:54 2005 UTC revision 1.118 by pfdietz, Mon May 2 11:21:02 2005 UTC
# Line 272  the condition to go uncaught if it canno Line 272  the condition to go uncaught if it canno
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))))
# Line 293  the condition to go uncaught if it canno Line 293  the condition to go uncaught if it canno
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)

Legend:
Removed from v.1.117  
changed lines
  Added in v.1.118

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26