diff --git a/collects/scheme/sandbox.ss b/collects/scheme/sandbox.ss index 098a931bd2..b9acb1ab9f 100644 --- a/collects/scheme/sandbox.ss +++ b/collects/scheme/sandbox.ss @@ -443,18 +443,20 @@ (define (evaluate-program program limit-thunk uncovered!) (when uncovered! (eval `(,#'#%require scheme/private/sandbox-coverage))) - ;; the actual evaluation happens under the specified limits - ((limit-thunk (lambda () - (if (and (pair? program) (eq? 'begin (car program))) - (eval* (cdr program)) - (eval program))))) (let ([ns (syntax-case* program (module) literal-identifier=? [(module mod . body) (identifier? #'mod) (let ([mod #'mod]) - (eval `(,#'require (quote ,mod))) - (module->namespace `(quote ,(syntax-e mod))))] + (lambda () + (eval `(,#'require (quote ,mod))) + (module->namespace `(quote ,(syntax-e mod)))))] [_else #f])]) + ;; the actual evaluation happens under the specified limits + ((limit-thunk (lambda () + (if (and (pair? program) (eq? 'begin (car program))) + (eval* (cdr program)) + (eval program)) + (when ns (set! ns (ns)))))) (when uncovered! (let ([get (let ([ns (current-namespace)]) (lambda () (eval '(get-uncovered-expressions) ns)))]) diff --git a/collects/tests/mzscheme/sandbox.ss b/collects/tests/mzscheme/sandbox.ss index 1f78204f8c..eb33961365 100644 --- a/collects/tests/mzscheme/sandbox.ss +++ b/collects/tests/mzscheme/sandbox.ss @@ -137,6 +137,18 @@ x =err> "terminated" ,eof =err> "terminated" + ;; eval-limits apply to the sandbox creation too + --top-- + (set! ev (parameterize ([sandbox-eval-limits '(0.25 5)]) + (make-evaluator 'scheme/base '(sleep 2)))) + =err> "out of time" + (set! ev (parameterize ([sandbox-eval-limits '(0.25 2)]) + (make-evaluator 'scheme/base + '(define a (for/list ([i (in-range 10)]) + (collect-garbage) + (make-string 1000)))))) + =err> "out of memory" + ;; i/o --top-- (set! ev (parameterize ([sandbox-input "3\n"]