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

move the reader of make-module-evaluator inside the user context jail

Browse Source 
svn: r11963
This commit is contained in:
Eli Barzilay 2008-10-07 14:20:18 +00:00
parent bbceacae84
commit 98975fc524
1 changed files with 19 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
collects/scheme/sandbox.ss
View File

@ -430,7 +430,7 @@
(define-evaluator-messenger get-error-output 'error-output) (define-evaluator-messenger get-error-output 'error-output)
(define-evaluator-messenger (get-uncovered-expressions . xs) 'uncovered) (define-evaluator-messenger (get-uncovered-expressions . xs) 'uncovered)
(define (make-evaluator* init-hook require-perms program-or-maker) (define (make-evaluator* init-hook require-perms program-maker)
(define cust (make-custodian)) (define cust (make-custodian))
(define coverage? (sandbox-coverage-enabled)) (define coverage? (sandbox-coverage-enabled))
(define uncovered #f) (define uncovered #f)
@ -458,7 +458,7 @@
((sandbox-init-hook)) ((sandbox-init-hook))
;; now read and evaluate the input program ;; now read and evaluate the input program
(evaluate-program (evaluate-program
(if (procedure? program-or-maker) (program-or-maker) program-or-maker) (if (procedure? program-maker) (program-maker) program-maker)
limits limits
(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))
@ -629,19 +629,21 @@
(define (make-module-evaluator (define (make-module-evaluator
input-program #:allow-read [allow null] #:language [reqlang #f]) input-program #:allow-read [allow null] #:language [reqlang #f])
;; this is for a complete module input program ;; this is for a complete module input program
(let ([prog (input->code (list input-program) 'program #f)]) (define (make-program)
(unless (= 1 (length prog)) (let ([prog (input->code (list input-program) 'program #f)])
(error 'make-evaluator "expecting a single `module' program; ~a" (unless (= 1 (length prog))
(if (zero? (length prog)) (error 'make-evaluator "expecting a single `module' program; ~a"
"no program expressions given" (if (zero? (length prog))
"got more than a single expression"))) "no program expressions given"
(syntax-case* (car prog) (module) literal-identifier=? "got more than a single expression")))
[(module modname lang body ...) (syntax-case* (car prog) (module) literal-identifier=?
(if (or (not reqlang) (equal? reqlang (syntax->datum #'lang))) [(module modname lang body ...)
(make-evaluator* void allow (car prog)) (if (or (not reqlang) (equal? reqlang (syntax->datum #'lang)))
(error 'make-evaluator (car prog)
"module code used `~e' for a language, expecting `~e'" (error 'make-evaluator
(syntax->datum #'lang) reqlang))] "module code used `~e' for a language, expecting `~e'"
[_else (error 'make-evaluator "expecting a `module' program; got ~e" (syntax->datum #'lang) reqlang))]
(syntax->datum (car prog)))]))) [_else (error 'make-evaluator "expecting a `module' program; got ~e"
(syntax->datum (car prog)))])))
(make-evaluator* void allow make-program))