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

fix more break-progaration problems in scheme/sandbox (where recent changes were not quite right)

Browse Source 
svn: r14219
This commit is contained in:
Matthew Flatt 2009-03-22 16:26:01 +00:00
parent 769ad3e98a
commit a61e7b67f9
1 changed files with 18 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/scheme/sandbox.ss
View File

@ -682,8 +682,8 @@
(evaluate-program (evaluate-program
(if (procedure? program-maker) (program-maker) program-maker) (if (procedure? program-maker) (program-maker) program-maker)
limit-thunk limit-thunk
(and coverage? (lambda (es+get) (set! uncovered es+get))))))) (and coverage? (lambda (es+get) (set! uncovered es+get))))))
(channel-put result-ch 'ok) (channel-put result-ch 'ok))
(set! eval-handler (cadr (sandbox-eval-handlers))) ; interactions handler (set! eval-handler (cadr (sandbox-eval-handlers))) ; interactions handler
;; finally wait for interaction expressions ;; finally wait for interaction expressions
(let ([n 0]) (let ([n 0])
@ -711,7 +711,6 @@
(call-with-values run list)))))) (call-with-values run list))))))
(loop))))))) (loop)))))))
(define (get-user-result) (define (get-user-result)
(let ([get-result (lambda () (sync user-done-evt result-ch))])
(if (and (sandbox-propagate-breaks) (if (and (sandbox-propagate-breaks)
;; The following test is weird. We reliably catch breaks if breaks ;; The following test is weird. We reliably catch breaks if breaks
;; are enabled, except that a break just before or after isn't ;; are enabled, except that a break just before or after isn't
@ -725,11 +724,9 @@
#f #f
(let loop () (let loop ()
(with-handlers* ([exn:break? (lambda (e) (user-break) (loop))]) (with-handlers* ([exn:break? (lambda (e) (user-break) (loop))])
(parameterize-break (sync/enable-break user-done-evt result-ch))))
#t ;; The simple case doesn't have to deal with breaks:
(get-result))))) (sync user-done-evt result-ch)))
;; The same case doesn't have to deal with breaks:
(get-result))))
(define (user-eval expr) (define (user-eval expr)
;; the thread will usually be running, but it might be killed outside of ;; the thread will usually be running, but it might be killed outside of
;; the sandboxed environment, for example, if you do something like ;; the sandboxed environment, for example, if you do something like