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

359.2, collects changes

Browse Source 
svn: r5143

original commit: cf0b303497763314db7f530a6e2d2010ffe44eac
This commit is contained in:
Matthew Flatt 2006-12-20 00:57:12 +00:00
parent c2750517a4
commit 9b81acb247
5 changed files with 32 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/framework/test.ss
View File

@ -156,11 +156,11 @@
(install-timer (run-interval) return) (install-timer (run-interval) return)
(unless (is-exn?) (unless (is-exn?)
(begin-action) (begin-action)
(parameterize ([current-exception-handler (call-with-exception-handler
(λ (exn) (λ (exn)
(end-action-with-error exn) (end-action-with-error exn)
((error-escape-handler)))]) ((error-escape-handler)))
(thunk)) thunk)
(end-action)))] (end-action)))]
[return (λ () (semaphore-post sem))]) [return (λ () (semaphore-post sem))])

20
collects/mred/private/lock.ss
View File

@ -50,16 +50,16 @@
(lambda () (lambda ()
(set! old-paramz (current-parameterization)) (set! old-paramz (current-parameterization))
(set! old-break-paramz (current-break-parameterization)) (set! old-break-paramz (current-break-parameterization))
(parameterize ([error-value->string-handler entered-err-string-handler] (parameterize ([error-value->string-handler entered-err-string-handler])
[current-exception-handler (with-handlers ([void (lambda (exn)
(lambda (exn) ;; Get out of atomic region before letting
;; Get out of atomic region before letting ;; an exception handler work
;; an exception handler work (k (lambda () (raise exn))))])
(k (lambda () (raise exn))))]) (parameterize-break
(parameterize-break #f #f
(call-with-values (call-with-values
f f
(lambda args (lambda () (apply values args))))))) (lambda args (lambda () (apply values args))))))))
(lambda () (lambda ()
(set! monitor-owner #f) (set! monitor-owner #f)
(semaphore-post monitor-sema) (semaphore-post monitor-sema)

5
collects/mred/private/repl.ss
View File

@ -120,7 +120,10 @@
void void
(lambda () (lambda ()
(call-with-values (call-with-values
(lambda () (eval (read (open-input-string expr-str)))) (lambda () (call-with-continuation-prompt
(lambda () (eval (cons
'#%top-interaction
(read (open-input-string expr-str)))))))
(lambda results (lambda results
(for-each (for-each
(lambda (v) (lambda (v)

7
collects/mred/private/snipfile.ss
View File

@ -208,7 +208,12 @@
(let ([exp (read-syntax src in-port)]) (let ([exp (read-syntax src in-port)])
(if (eof-object? exp) (if (eof-object? exp)
(apply values last-time-values) (apply values last-time-values)
(call-with-values (lambda () (eval exp)) (call-with-values (lambda () (call-with-continuation-prompt
(lambda () (eval
(datum->syntax-object
#f
(cons '#%top-interaction exp)
exp)))))
(lambda x (loop x))))))))) (lambda x (loop x)))))))))
(lambda () (lambda ()
(close-input-port in-port))))) (close-input-port in-port)))))

10
collects/tests/framework/framework-test-engine.ss
View File

@ -63,13 +63,17 @@
[port (current-output-port)]) [port (current-output-port)])
(event-dispatch-handler (event-dispatch-handler
(lambda (evt) (lambda (evt)
(parameterize ([current-exception-handler (parameterize ([uncaught-exception-handler
(let ([oe (current-exception-handler)]) (let ([oe (uncaught-exception-handler)])
(lambda (exn) (lambda (exn)
(protect (protect
(lambda () (lambda ()
(set! errs (cons exn errs)))) (set! errs (cons exn errs))))
(oe exn)))]) (oe exn)))])
(od evt))))) (call-with-exception-handler
(lambda (exn)
((uncaught-exception-handler) exn))
(lambda ()
(od evt)))))))
(yield (make-semaphore 0))) (yield (make-semaphore 0)))