From 55f1df58e1e187900ae876cf1794ed4770b43162 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Sat, 13 Dec 2008 16:41:07 +0000
Subject: [PATCH] Make sure that the module is also instantiated under the
 evaluation limits too (the instantiation was happening outside of the limited
 thunk)

svn: r12830
---
 collects/scheme/sandbox.ss         | 16 +++++++++-------
 collects/tests/mzscheme/sandbox.ss | 12 ++++++++++++
 2 files changed, 21 insertions(+), 7 deletions(-)

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"]