diff --git a/collects/tests/mzscheme/quiet.ss b/collects/tests/mzscheme/quiet.ss index c35ae16081..1956da38fb 100644 --- a/collects/tests/mzscheme/quiet.ss +++ b/collects/tests/mzscheme/quiet.ss @@ -5,6 +5,8 @@ (let ([argv (current-command-line-arguments)]) (if (= 1 (vector-length argv)) (vector-ref argv 0) "all.ss"))))) +(define timeout-thread #f) + (namespace-variable-value 'real-error-port #f (lambda () (let ([err (current-error-port)] @@ -23,13 +25,15 @@ (set! last-error e)) (errh e))) ;; -- set up a timeout - (thread (lambda () - (sleep 900) - (fprintf err "\n\n~aTIMEOUT -- ABORTING!\n" Section-prefix) - (exit 3) - ;; in case the above didn't work for some reason - (sleep 60) - (custodian-shutdown-all cust)))))) + (set! timeout-thread + (thread + (lambda () + (sleep 1200) + (fprintf err "\n\n~aTIMEOUT -- ABORTING!\n" Section-prefix) + (exit 3) + ;; in case the above didn't work for some reason + (sleep 60) + (custodian-shutdown-all cust))))))) (let ([p (make-output-port 'quiet always-evt (lambda (str s e nonblock? breakable?) (- e s)) @@ -37,7 +41,8 @@ (call-with-continuation-prompt (lambda () (parameterize ([current-output-port p] [current-error-port p]) - (load-relative quiet-load))) + (load-relative quiet-load)) + (kill-thread timeout-thread)) (default-continuation-prompt-tag) (lambda (thunk) (when last-error diff --git a/collects/tests/run-automated-tests.ss b/collects/tests/run-automated-tests.ss index 2df9b00213..b0978b659b 100755 --- a/collects/tests/run-automated-tests.ss +++ b/collects/tests/run-automated-tests.ss @@ -64,8 +64,9 @@ (set! exit-code (max exit-code n)) (echo "BOOM!") ; used to find errors in nightly builds (break))) - (thread (let ([th (current-thread)]) - (lambda () (sleep 900) (echo "Timeout!") (break-thread th)))) + (define timeout-thread + (thread (let ([th (current-thread)]) + (lambda () (sleep 1200) (echo "Timeout!") (break-thread th))))) (parameterize* ([exit-handler (lambda (n) (abort n "exit with error code ~a" n))] [current-namespace (make-base-empty-namespace)]) @@ -78,6 +79,7 @@ (with-handlers ([void (lambda (exn) (abort 1 "error: ~a" (exn-message exn)))]) (thunk)))) + (kill-thread timeout-thread) (echo "all tests passed.")))) (exit exit-code)