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

forbid nested evaluator calls

Browse Source 
svn: r13338
This commit is contained in:
Eli Barzilay 2009-01-31 19:44:20 +00:00
parent 2fdc3ad68b
commit 39e07d0843
1 changed files with 12 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/scheme/sandbox.ss
View File

@ -702,15 +702,18 @@
;; limits (since then you get a different thread, which is already dead).
(when (and user-thread (thread-dead? user-thread))
(terminate+kill! #t #t))
(cond
[terminated? => raise]
[(not user-thread) (error 'sandbox "internal error (user-thread is #f)")]
[else
(channel-put input-ch expr)
(let ([r (get-user-result)])
(cond [(eof-object? r) (terminate+kill! #t #t)]
[(eq? (car r) 'exn) (raise (cdr r))]
[else (apply values (cdr r))]))]))
(cond [terminated? => raise]
[(not user-thread)
(error 'sandbox "internal error (user-thread is #f)")]
;; try to put the expression in, but if can't then it means that the
;; evaluator is calling itself -- there is no simple way to make this
;; work, so throw an error
[(not (sync/timeout 0 (channel-put-evt input-ch expr)))
(error 'evaluator "nested evaluator call with: ~e" expr)]
[else (let ([r (get-user-result)])
(cond [(eof-object? r) (terminate+kill! #t #t)]
[(eq? (car r) 'exn) (raise (cdr r))]
[else (apply values (cdr r))]))]))
(define get-uncovered
(case-lambda
[() (get-uncovered #t)]