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

termination message now indicates suicides too (both killing the

Browse Source 
thread or shutting the custodian)

svn: r12838
This commit is contained in:
Eli Barzilay 2008-12-13 22:39:49 +00:00
parent 188489b34f
commit 813eb20e35
2 changed files with 24 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/scheme/sandbox.ss
View File

@ -532,6 +532,7 @@
(define memory-cust (make-custodian orig-cust))
(define memory-cust-box (make-custodian-box memory-cust #t))
(define user-cust (make-custodian memory-cust))
(define user-cust-box (make-custodian-box user-cust #t))
(define coverage? (sandbox-coverage-enabled))
(define uncovered #f)
(define input-ch (make-channel))
@ -733,8 +734,15 @@
;; must be nested in the above (which is what paramaterize* does), or
;; it will not use the new namespace.
[current-eventspace (make-eventspace)])
(set! user-thread (bg-run->thread (run-in-bg user-process)))
(set! user-done-evt (handle-evt user-thread (lambda (_) (user-kill) eof)))
(let ([t (bg-run->thread (run-in-bg user-process))])
(define (on-done _)
(terminated! (if (custodian-box-value user-cust-box)
'thread-killed
'custodian-shutdown))
(user-kill)
eof)
(set! user-done-evt (handle-evt t on-done))
(set! user-thread t))
(let ([r (channel-get result-ch)])
(if (eq? r 'ok)
;; initial program executed ok, so return an evaluator

26
collects/tests/mzscheme/sandbox.ss
View File

@ -139,7 +139,7 @@
;; other termination messages
--top-- (set! ev (make-evaluator 'scheme/base)) (kill-evaluator ev)
--eval-- 123 =err> "terminated .evaluator-killed."
--eval-- 123 =err> "terminated .evaluator-killed.$"
;; eval-limits apply to the sandbox creation too
--top--
@ -202,9 +202,9 @@
--top--
(kill-evaluator ev) => (void)
--eval--
x =err> "terminated .evaluator-killed."
y =err> "terminated .evaluator-killed."
,eof =err> "terminated .evaluator-killed."
x =err> "terminated .evaluator-killed.$"
y =err> "terminated .evaluator-killed.$"
,eof =err> "terminated .evaluator-killed.$"
--top--
(let-values ([(i1 o1) (make-pipe)] [(i2 o2) (make-pipe)])
;; o1 -> i1 -ev-> o2 -> i2
@ -417,40 +417,42 @@
(set! ev (parameterize ([sandbox-eval-limits #f])
(make-evaluator 'scheme/base)))
--eval--
(kill-thread (current-thread)) =err> "terminated"
(kill-thread (current-thread)) =err> "terminated .thread-killed.$"
--top--
(set! ev (parameterize ([sandbox-eval-limits #f])
(make-evaluator 'scheme/base)))
--eval--
(custodian-shutdown-all (current-custodian)) =err> "terminated"
(custodian-shutdown-all (current-custodian))
=err> "terminated .custodian-shutdown.$"
--top--
;; also happens when it's done directly
(set! ev (parameterize ([sandbox-eval-limits #f])
(make-evaluator 'scheme/base)))
(call-in-sandbox-context ev (lambda () (kill-thread (current-thread))))
=err> "terminated"
=err> "terminated .thread-killed.$"
(set! ev (parameterize ([sandbox-eval-limits #f])
(make-evaluator 'scheme/base)))
(call-in-sandbox-context ev
(lambda () (custodian-shutdown-all (current-custodian))))
=err> "terminated"
=err> "terminated .custodian-shutdown.$"
--top--
;; now make sure it works with per-expression limits too
(set! ev (make-evaluator 'scheme/base))
--eval--
(kill-thread (current-thread)) =err> "terminated"
(kill-thread (current-thread)) =err> "terminated .thread-killed.$"
--top--
(set! ev (make-evaluator 'scheme/base))
--eval--
(custodian-shutdown-all (current-custodian)) =err> "terminated"
(custodian-shutdown-all (current-custodian))
=err> "terminated .custodian-shutdown.$"
--top--
(set! ev (make-evaluator 'scheme/base))
(call-in-sandbox-context ev (lambda () (kill-thread (current-thread))))
=err> "terminated"
=err> "terminated .thread-killed.$"
(set! ev (make-evaluator 'scheme/base))
(call-in-sandbox-context ev
(lambda () (custodian-shutdown-all (current-custodian))))
=err> "terminated"
=err> "terminated .custodian-shutdown.$"
;; when an expression is out of memory, the sandbox should stay alive
--top--