suzanne.soy/compatibility
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

original commit: 6c13e101bfc3f4f18c08f6bcdd8c0a23556c2a70
This commit is contained in:
Eli Barzilay 2007-10-07 18:12:11 +00:00
parent 3145244ce3
commit b04157aa61
1 changed files with 10 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 loop ([n 1])
(let ([expr (channel-get input-ch)]) (let ([expr (channel-get input-ch)])
(when (eof-object? expr) (channel-put result-ch expr) (user-kill)) (when (eof-object? expr) (channel-put result-ch expr) (user-kill))
(let ([code (input->code (list expr) 'eval n)]) (with-handlers ([void (lambda (exn)
(with-handlers ([void (lambda (exn) (channel-put result-ch (cons 'exn exn)))])
(channel-put result-ch (cons 'exn exn)))]) (let* ([code (input->code (list expr) 'eval n)]
(let* ([sec (and limits (car limits))] [sec (and limits (car limits))]
[mb (and limits (cadr limits))] [mb (and limits (cadr limits))]
[run (if (or sec mb) [run (if (or sec mb)
(lambda () (with-limits sec mb (eval* code))) (lambda () (with-limits sec mb (eval* code)))
(lambda () (eval* code)))]) (lambda () (eval* code)))])
(channel-put result-ch (channel-put result-ch
(cons 'vals (call-with-values run list)))))) (cons 'vals (call-with-values run list)))))
(loop (add1 n))))) (loop (add1 n)))))
(define (user-eval expr) (define (user-eval expr)
(let ([r (if user-thread (let ([r (if user-thread