From 6c13e101bfc3f4f18c08f6bcdd8c0a23556c2a70 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Sun, 7 Oct 2007 18:12:11 +0000
Subject: [PATCH] fix bad input to raise an error as usual, added tests

svn: r7445
---
 collects/mzlib/sandbox.ss          | 20 ++++++++++----------
 collects/tests/mzscheme/sandbox.ss | 14 ++++++++++++++
 2 files changed, 24 insertions(+), 10 deletions(-)

diff --git a/collects/mzlib/sandbox.ss b/collects/mzlib/sandbox.ss
index d040cf82dd..6aa661fbd5 100644
--- a/collects/mzlib/sandbox.ss
+++ b/collects/mzlib/sandbox.ss
@@ -431,16 +431,16 @@
       (let loop ([n 1])
         (let ([expr (channel-get input-ch)])
           (when (eof-object? expr) (channel-put result-ch expr) (user-kill))
-          (let ([code (input->code (list expr) 'eval n)])
-            (with-handlers ([void (lambda (exn)
-                                    (channel-put result-ch (cons 'exn exn)))])
-              (let* ([sec (and limits (car limits))]
-                     [mb  (and limits (cadr limits))]
-                     [run (if (or sec mb)
-                            (lambda () (with-limits sec mb (eval* code)))
-                            (lambda () (eval* code)))])
-                (channel-put result-ch
-                             (cons 'vals (call-with-values run list))))))
+          (with-handlers ([void (lambda (exn)
+                                  (channel-put result-ch (cons 'exn exn)))])
+            (let* ([code (input->code (list expr) 'eval n)]
+                   [sec (and limits (car limits))]
+                   [mb  (and limits (cadr limits))]
+                   [run (if (or sec mb)
+                          (lambda () (with-limits sec mb (eval* code)))
+                          (lambda () (eval* code)))])
+              (channel-put result-ch
+                           (cons 'vals (call-with-values run list)))))
           (loop (add1 n)))))
     (define (user-eval expr)
       (let ([r (if user-thread
diff --git a/collects/tests/mzscheme/sandbox.ss b/collects/tests/mzscheme/sandbox.ss
index 3b1dc8626c..02277f5efb 100644
--- a/collects/tests/mzscheme/sandbox.ss
+++ b/collects/tests/mzscheme/sandbox.ss
@@ -55,6 +55,20 @@
    x => 1
    (id 1) => 1
    (id (plus1 x)) => 1
+   (define id2 id)
+   (id2 (id x)) => 1
+   blah =err> "before its definition"
+   ;; using a string for an input
+   "1" => 1
+   "(+ 1 2) x (define y 9) y (set! y 99) y" => 99
+   "bad\"string" =err> "expected a closing"
+   "bad(string" =err> "expected a .\\)."
+   "bad)string" =err> "unexpected .\\)."
+   "(set! y 999) (string" =err> "expected a .\\)."
+   y => 99
+   "(set! y 999) (if)" =err> "if: bad syntax"
+   y => 999
+   ;; test limits
    (loop) =err> "out of time"
    --top--
    (when (custodian-memory-accounting-available?)