/[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.119 by pfdietz, Mon May 2 12:22:52 2005 UTC revision 1.120 by pfdietz, Thu May 5 03:08:00 2005 UTC
# Line 286  the condition to go uncaught if it canno Line 286  the condition to go uncaught if it canno
286                                            (declare (optimize (safety ,safety)))                                            (declare (optimize (safety ,safety)))
287                                            ,form)))                                            ,form)))
288                 (eval ',form))))                 (eval ',form))))
289       (,error-name (c)       (,error-name (c)
290                    (cond                    (cond
291                     ,@(if (eq error-name 'type-error)                     ,@(case error-name
292                           `(((typep (type-error-datum c)                         (type-error
293                                     (type-error-expected-type c))                          `(((typep (type-error-datum c)
294                              (values                                    (type-error-expected-type c))
295                               nil                             (values
296                               (list (list 'typep (list 'quote                              nil
297                                                        (type-error-datum c))                              (list (list 'typep (list 'quote
298                                           (list 'quote                                                       (type-error-datum c))
299                                                 (type-error-expected-type c)))                                          (list 'quote
300                                     "==> true"))))                                                (type-error-expected-type c)))
301                         nil)                                    "==> true")))))
302                     ,@(if (and name-p (member error-name '(undefined-function                         ((undefined-function unbound-variable)
303                                                            unbound-variable)))                          (and name-p
304                           `(((not (eq (cell-error-name c) ',name))                               `(((not (eq (cell-error-name c) ',name))
305                              (values                                  (values
306                               nil                                   nil
307                               (list 'cell-error-name "==>"                                   (list 'cell-error-name "==>"
308                                     (cell-error-name c)))))                                         (cell-error-name c)))))))
309                         nil)                                         ((stream-error end-of-file reader-error)
310                            `(((not (streamp (stream-error-stream c)))
311                               (values
312                                nil
313                                (list 'stream-error-stream "==>"
314                                      (stream-error-stream c))))))
315                           (file-error
316                            `(((not (pathnamep (pathname (file-error-pathname c))))
317                               (values
318                                nil
319                                (list 'file-error-pathname "==>"
320                                      (file-error-pathname c))))))
321                           (t nil))
322                     (t (printable-p c)))))))                     (t (printable-p c)))))))
323    
324  (defmacro signals-error-always (form error-name)  (defmacro signals-error-always (form error-name)

Legend:
Removed from v.1.119  
changed lines
  Added in v.1.120

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