From 99dc711ac0ef0123284656cef998802d884473cb Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Mon, 15 Sep 2008 09:57:16 +0000 Subject: [PATCH] Removed the redundant uncaught-exception-handler setting, use with-handlers except for the mzscheme tests svn: r11755 --- collects/tests/run-automated-tests.ss | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/collects/tests/run-automated-tests.ss b/collects/tests/run-automated-tests.ss index cb89a914c4..a1ee31b382 100755 --- a/collects/tests/run-automated-tests.ss +++ b/collects/tests/run-automated-tests.ss @@ -27,9 +27,11 @@ ;; Each should be a list with a mode symbol (`load' or `require'), ;; the path to the test file (relative to this script) and module ;; specifications for things to require into the initial namespace -;; for the test before the test is loaded. +;; for the test before the test is loaded. ('no-handler is a +;; special flag that means that errors raised by the test suite are +;; ignored, and should only be used by the mzscheme tests.) (define tests - '([load "mzscheme/quiet.ss" (lib "scheme/init")] + '([no-handler load "mzscheme/quiet.ss" (lib "scheme/init")] [require "typed-scheme/main.ss"] [require "match/plt-match-tests.ss"] ;; [require "stepper/automatic-tests.ss" (lib "scheme/base")] @@ -44,11 +46,11 @@ (define exit-code 0) (for ([t tests]) + (define no-handler? (and (eq? 'no-handler (car t)) (set! t (cdr t)))) (define name (cadr t)) (define stderr (current-error-port)) (define (echo fmt . args) (fprintf stderr "*** ~a: ~a\n" name (apply format fmt args))) - (define orig-exn-handler (uncaught-exception-handler)) (newline stderr) (echo "running...") (let/ec break @@ -62,15 +64,16 @@ (lambda () (sleep 900) (echo "Timeout!") (break-thread th)))) (parameterize* ([exit-handler (lambda (n) (abort n "exit with error code ~a" n))] - [uncaught-exception-handler - (lambda (exn) - (if (eq? orig-exn-handler (uncaught-exception-handler)) - (abort 1 "error: ~a" (exn-message exn)) - (orig-exn-handler exn)))] [current-namespace (make-base-empty-namespace)]) (for-each namespace-require (cddr t)) - ((case (car t) [(load) load] [(require) namespace-require]) - (build-path here name)) + (let ([thunk (lambda () + ((case (car t) [(load) load] [(require) namespace-require]) + (build-path here name)))]) + (if no-handler? + (thunk) + (with-handlers ([void (lambda (exn) + (abort 1 "error: ~a" (exn-message exn)))]) + (thunk)))) (echo "all tests passed.")))) (exit exit-code)