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

added timeout to quiet.ss

Browse Source 
svn: r3657
This commit is contained in:
Eli Barzilay 2006-07-07 23:56:37 +00:00
parent ead6ec7bdc
commit c8cb92db51
1 changed files with 7 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/tests/mzscheme/quiet.ss
View File

@ -7,7 +7,13 @@
(namespace-variable-value 'real-error-port #f (namespace-variable-value 'real-error-port #f
(lambda () (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 (let ([p (make-output-port
'quiet always-evt (lambda (str s e nonblock? breakable?) (- e s)) 'quiet always-evt (lambda (str s e nonblock? breakable?) (- e s))