/[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.7 by pfdietz, Sat Oct 19 13:10:23 2002 UTC revision 1.8 by pfdietz, Thu Oct 24 03:21:50 2002 UTC
# Line 129  the condition to go uncaught if it canno Line 129  the condition to go uncaught if it canno
129    (handler-case ,form    (handler-case ,form
130       (undefined-function () 'undefined-function)       (undefined-function () 'undefined-function)
131       (program-error () 'program-error)       (program-error () 'program-error)
132         (package-error () 'package-error)
133       (type-error    () 'type-error)       (type-error    () 'type-error)
134       (control-error () 'control-error)       (control-error () 'control-error)
135    )))    )))
# Line 270  the condition to go uncaught if it canno Line 271  the condition to go uncaught if it canno
271                  when c collect c)                  when c collect c)
272            'string))            'string))
273  (defparameter +rev-code-chars+ (reverse +code-chars+))  (defparameter +rev-code-chars+ (reverse +code-chars+))
274    
275    ;;; Used in checking for continuable errors
276    
277    (defun has-non-abort-restart (c)
278      (throw 'handled
279             (if (position 'abort (compute-restarts c)
280                           :key #'restart-name :test-not #'eq)
281                 'success
282               'fail)))
283    
284    (defmacro handle-non-abort-restart (&body body)
285      `(catch 'handled
286         (handler-bind ((error #'has-non-abort-restart))
287                       ,@body)))
288    

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

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