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

try to fix quiet.ss

Browse Source 
svn: r5180
This commit is contained in:
Matthew Flatt 2006-12-25 06:41:29 +00:00
parent 3e679de9a5
commit a3fb51d8d2
1 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -14,16 +14,16 @@
[cust (current-custodian)]
[orig-thread (current-thread)])
(namespace-set-variable-value! 'real-error-port err)
(namespace-set-variable-value! 'last-error #f)
;; we're loading this for the first time:
;; -- make real errors show
;; (can't override current-exception-handler alone, since the escape
;; handler is overridden to avoid running off, so use the first to
;; save the data and the second to show it)
(let ([last-error #f])
(uncaught-exception-handler (lambda (e)
(when (eq? (current-thread) orig-thread)
(set! last-error e))
(errh e))))
(uncaught-exception-handler (lambda (e)
(when (eq? (current-thread) orig-thread)
(set! last-error e))
(errh e)))
;; -- set up a timeout
(thread (lambda ()
(sleep 600)
@ -41,9 +41,9 @@
(parameterize ([current-output-port p] [current-error-port p])
(load-relative quiet-load)))
(default-continuation-prompt-tag)
(lambda ()
(lambda (thunk)
(when last-error
(fprintf err "ERROR: ~a\n"
(fprintf real-error-port "ERROR: ~a\n"
(if (exn? last-error) (exn-message last-error) last-error))
(exit 2))))
(report-errs #t))