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

fix bad input to raise an error as usual, added tests

Browse Source 
svn: r7445
This commit is contained in:
Eli Barzilay 2007-10-07 18:12:11 +00:00
parent c4a297c579
commit 6c13e101bf
2 changed files with 24 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/mzlib/sandbox.ss
View File

@ -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

14
collects/tests/mzscheme/sandbox.ss
View File

@ -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?)