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

small fix, other minor things

Browse Source 
svn: r12784
This commit is contained in:
Eli Barzilay 2008-12-12 10:29:28 +00:00
parent 6af93d9775
commit c979ffa85a
1 changed files with 7 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/scheme/sandbox.ss
View File

@ -226,7 +226,7 @@
[kill (lambda () (kill-thread (current-thread)))] [kill (lambda () (kill-thread (current-thread)))]
[shutdown (lambda () (custodian-shutdown-all (current-custodian)))]) [shutdown (lambda () (custodian-shutdown-all (current-custodian)))])
(let* ([p #f] (let* ([p #f]
[c (make-custodian)] [c (make-custodian (current-custodian))]
[b (make-custodian-box c #t)]) [b (make-custodian-box c #t)])
(with-handlers ([(lambda (_) (not p)) (with-handlers ([(lambda (_) (not p))
;; if the after thunk was not called, then this error is ;; if the after thunk was not called, then this error is
@ -465,7 +465,8 @@
(define-evaluator-messenger (call-in-sandbox-context thunk) 'thunk) (define-evaluator-messenger (call-in-sandbox-context thunk) 'thunk)
(define (make-evaluator* init-hook allow program-maker) (define (make-evaluator* init-hook allow program-maker)
(define user-cust (make-custodian)) (define orig-cust (current-custodian))
(define user-cust (make-custodian orig-cust))
(define coverage? (sandbox-coverage-enabled)) (define coverage? (sandbox-coverage-enabled))
(define uncovered #f) (define uncovered #f)
(define input-ch (make-channel)) (define input-ch (make-channel))
@ -476,7 +477,6 @@
(define limits (sandbox-eval-limits)) (define limits (sandbox-eval-limits))
(define user-thread #t) ; set later to the thread (define user-thread #t) ; set later to the thread
(define user-done-evt #t) ; set in the same place (define user-done-evt #t) ; set in the same place
(define orig-cust (current-custodian))
(define (limit-thunk thunk) (define (limit-thunk thunk)
(let* ([sec (and limits (car limits))] (let* ([sec (and limits (car limits))]
[mb (and limits (cadr limits))]) [mb (and limits (cadr limits))])
@ -667,10 +667,7 @@
(lambda () (build-program lang reqs input-program))))) (lambda () (build-program lang reqs input-program)))))
(define (make-module-evaluator (define (make-module-evaluator
input-program input-program #:allow-read [allow null] #:language [reqlang #f])
#:allow-read [allow
(if (path? input-program) (list input-program) null)]
#:language [reqlang #f])
;; this is for a complete module input program ;; this is for a complete module input program
(define (make-program) (define (make-program)
(let ([prog (input->code (list input-program) 'program #f)]) (let ([prog (input->code (list input-program) 'program #f)])
@ -688,5 +685,6 @@
(syntax->datum #'lang) reqlang))] (syntax->datum #'lang) reqlang))]
[_else (error 'make-evaluator "expecting a `module' program; got ~e" [_else (error 'make-evaluator "expecting a `module' program; got ~e"
(syntax->datum (car prog)))]))) (syntax->datum (car prog)))])))
(make-evaluator* void allow make-program)) (make-evaluator* void
(if (path? input-program) (cons input-program allow) allow)
make-program))