/[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.72 by pfdietz, Tue Jul 1 02:08:54 2003 UTC revision 1.73 by pfdietz, Thu Jul 3 12:14:04 2003 UTC
# Line 223  Results: ~A~%" expected-number form n re Line 223  Results: ~A~%" expected-number form n re
223        for x in *universe* count        for x in *universe* count
224          (block failed          (block failed
225            (let ((p1 (handler-case            (let ((p1 (handler-case
226                          (funcall (the function p) x)                          (normally (funcall (the function p) x))
227                        (error () (format t "(FUNCALL ~S ~S) failed~%"                        (error () (format t "(FUNCALL ~S ~S) failed~%"
228                                          P x)                                          P x)
229                          (return-from failed t))))                          (return-from failed t))))
230                  (p2 (handler-case                  (p2 (handler-case
231                          (typep x TYPE)                          (normally (typep x TYPE))
232                        (error () (format t "(TYPEP ~S '~S) failed~%"                        (error () (format t "(TYPEP ~S '~S) failed~%"
233                                          x TYPE)                                          x TYPE)
234                          (return-from failed t)))))                          (return-from failed t)))))
# Line 273  Results: ~A~%" expected-number form n re Line 273  Results: ~A~%" expected-number form n re
273  If an error does occur, return type-error on TYPE-ERRORs, or the error  If an error does occur, return type-error on TYPE-ERRORs, or the error
274  condition itself on other errors."  condition itself on other errors."
275  `(locally (declare (optimize (safety 3)))  `(locally (declare (optimize (safety 3)))
276    (handler-case ,form    (handler-case (normally ,form)
277       (type-error () 'type-error)       (type-error () 'type-error)
278       (error (c) c))))       (error (c) c))))
279    
# Line 282  condition itself on other errors." Line 282  condition itself on other errors."
282  If an error does occur, return a symbol classify the error, or allow  If an error does occur, return a symbol classify the error, or allow
283  the condition to go uncaught if it cannot be classified."  the condition to go uncaught if it cannot be classified."
284  `(locally (declare (optimize (safety 3)))  `(locally (declare (optimize (safety 3)))
285    (handler-case ,form    (handler-case (normally ,form)
286       (undefined-function () 'undefined-function)       (undefined-function () 'undefined-function)
287       (program-error () 'program-error)       (program-error () 'program-error)
288       (package-error () 'package-error)       (package-error () 'package-error)
# Line 386  the condition to go uncaught if it canno Line 386  the condition to go uncaught if it canno
386  ;;;     (defun complement (fn)  ;;;     (defun complement (fn)
387  ;;;       #'(lambda (&rest args) (not (apply fn args))))))  ;;;       #'(lambda (&rest args) (not (apply fn args))))))
388    
389    
390    (declaim (ftype (function (&rest function) (values function &optional))
391                    compose))
392    
393  (defun compose (&rest fns)  (defun compose (&rest fns)
394    (let ((rfns (reverse fns)))    (let ((rfns (reverse fns)))
395      #'(lambda (x) (loop for f      #'(lambda (x) (loop for f
# Line 434  the condition to go uncaught if it canno Line 438  the condition to go uncaught if it canno
438   " 'simple-base-string))   " 'simple-base-string))
439    
440  (defparameter  (defparameter
441    +base-chars+ #.(concatenate 'simple-base-string    +base-chars+ #.(coerce
442                                "abcdefghijklmnopqrstuvwxyz"                    (concatenate 'string
443                                "ABCDEFGHIJKLMNOPQRSTUVWXYZ"                                 "abcdefghijklmnopqrstuvwxyz"
444                                "0123456789"                                 "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
445                                "<,>.?/\"':;[{]}~`!@#$%^&*()_-+= \\|"))                                 "0123456789"
446                                   "<,>.?/\"':;[{]}~`!@#$%^&*()_-+= \\|")
447                      'simple-base-string))
448                      
449    
450  (declaim (type simple-base-string +base-chars+))  (declaim (type simple-base-string +base-chars+))
451    
# Line 1277  the condition to go uncaught if it canno Line 1284  the condition to go uncaught if it canno
1284    `(eval-when #+gcl (load eval compile)    `(eval-when #+gcl (load eval compile)
1285                #-gcl (:load-toplevel :compile-toplevel :execute)                #-gcl (:load-toplevel :compile-toplevel :execute)
1286       (handler-case (eval '(defstruct ,@args))       (handler-case (eval '(defstruct ,@args))
1287                     (serious-condition () nil))))                        (serious-condition () nil))))
1288    
1289  (defun sort-package-list (x)  (defun sort-package-list (x)
1290    (sort (copy-list x)    (sort (copy-list x)

Legend:
Removed from v.1.72  
changed lines
  Added in v.1.73

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