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

39
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,25 +711,22 @@
(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 ;; reliably propagated. A `get-result/enable-breaks' function
;; reliably propagated. A `get-result/enable-breaks' function ;; would make more sense.
;; would make more sense. (break-enabled))
(break-enabled)) ;; The following loop ensures that breaks are disabled while trying
;; The following loop ensures that breaks are disabled while trying ;; to handle a break, which ensures that we don't fail to
;; to handle a break, which ensures that we don't fail to ;; propagate a break.
;; propagate a break. (parameterize-break
(parameterize-break #f
#f (let loop ()
(let loop () (with-handlers* ([exn:break? (lambda (e) (user-break) (loop))])
(with-handlers* ([exn:break? (lambda (e) (user-break) (loop))]) (sync/enable-break user-done-evt result-ch))))
(parameterize-break ;; The simple case doesn't have to deal with breaks:
#t (sync user-done-evt result-ch)))
(get-result)))))
;; 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