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