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

fix the test-suite sandbox

Browse Source 
svn: r12907
This commit is contained in:
Matthew Flatt 2008-12-19 20:58:56 +00:00
parent 064776348a
commit 23e8624e41
1 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/tests/mzscheme/testing.ss
View File

@ -79,11 +79,12 @@ transcript.
(define (load-in-sandbox file) (define (load-in-sandbox file)
(define-syntax-rule (S id) (dynamic-require 'scheme/sandbox 'id)) (define-syntax-rule (S id) (dynamic-require 'scheme/sandbox 'id))
(let ([e ((S call-with-trusted-sandbox-configuration) (let ([e ((S call-with-trusted-sandbox-configuration)
(parameterize ([(S sandbox-input) current-input-port] (lambda ()
[(S sandbox-output) current-output-port] (parameterize ([(S sandbox-input) current-input-port]
[(S sandbox-error-output) current-error-port] [(S sandbox-output) current-output-port]
[(S sandbox-memory-limit) 100]) ; 100mb per box [(S sandbox-error-output) current-error-port]
((S make-evaluator) '(begin) #:requires (list 'scheme))))]) [(S sandbox-memory-limit) 100]) ; 100mb per box
((S make-evaluator) '(begin) #:requires (list 'scheme)))))])
(e `(load-relative "testing.ss")) (e `(load-relative "testing.ss"))
(e `(define real-error-port (quote ,real-error-port))) (e `(define real-error-port (quote ,real-error-port)))
(e `(define Section-prefix ,Section-prefix)) (e `(define Section-prefix ,Section-prefix))