suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixed exn handler

Browse Source 
svn: r9716
This commit is contained in:
Eli Barzilay 2008-05-07 02:07:43 +00:00
parent c383bfdab2
commit db46754271
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/tests/run-automated-tests.ss
View File

@ -36,16 +36,15 @@
(define-runtime-path here ".")
(define (eprintf fmt . xs)
(apply fprintf (current-error-port) fmt xs))
(define exit-code 0)
(for ([t tests])
(define name (cadr t))
(define stderr (current-error-port))
(define (echo fmt . args)
(fprintf (current-error-port) "*** ~a: ~a\n" name (apply format fmt args)))
(newline (current-error-port))
(fprintf stderr "*** ~a: ~a\n" name (apply format fmt args)))
(define orig-exn-handler (uncaught-exception-handler))
(newline stderr)
(echo "running...")
(let/ec break
(define (abort n fmt . xs)
@ -59,7 +58,9 @@
(parameterize* ([exit-handler
(lambda (n) (abort n "exit with error code ~a" n))]
[uncaught-exception-handler
(lambda (exn) (abort 1 "error: ~a" (exn-message exn)))]
(lambda (exn)
(when (eq? orig-exn-handler (uncaught-exception-handler))
(abort 1 "error: ~a" (exn-message exn))))]
[current-namespace (make-base-empty-namespace)])
(for-each namespace-require (cddr t))
((case (car t) [(load) load] [(require) namespace-require])