From c8cb92db516257cf98e44aa97865628cae9fa3bf Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Fri, 7 Jul 2006 23:56:37 +0000 Subject: [PATCH] added timeout to quiet.ss svn: r3657 --- collects/tests/mzscheme/quiet.ss | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/collects/tests/mzscheme/quiet.ss b/collects/tests/mzscheme/quiet.ss index a141b65c24..4115aec669 100644 --- a/collects/tests/mzscheme/quiet.ss +++ b/collects/tests/mzscheme/quiet.ss @@ -7,7 +7,13 @@ (namespace-variable-value 'real-error-port #f (lambda () - (namespace-set-variable-value! 'real-error-port (current-error-port)))) + (let ([e (current-error-port)] [ex (exit-handler)] [c (current-custodian)]) + (namespace-set-variable-value! 'real-error-port e) + ;; we're loading this for the first time -- set up a timeout + (thread (lambda () + (sleep 600) (fprintf e "\n\nTIMEOUT -- ABORTING!\n") (ex 2) + ;; in case the above didn't work for some reason + (sleep 60) (custodian-shutdown-all c)))))) (let ([p (make-output-port 'quiet always-evt (lambda (str s e nonblock? breakable?) (- e s))