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

put mzlib test suites into separate sandboxes

Browse Source 
svn: r8058
This commit is contained in:
Matthew Flatt 2007-12-19 04:12:02 +00:00
parent eccb9b5aa6
commit 36c5684876
5 changed files with 47 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/tests/mzscheme/contract-mzlib-test.ss
View File

@ -18,7 +18,8 @@ of the contract library does not change over time.
(namespace-require '(for-syntax mzscheme))
(namespace-require '(for-template mzscheme))
(namespace-require 'mzlib/contract)
(namespace-require 'mzlib/class))
(namespace-require 'mzlib/class)
(namespace-require '(only mzscheme force delay)))
n))
(define (contract-eval x)

2
collects/tests/mzscheme/macrolib.ss
View File

@ -66,7 +66,7 @@
(syntax-test #'(let ([define-values 10]) (local ((define-values (x) 4)) 10)))
(syntax-test #'(let ([define-struct 10]) (local ((define-struct x ())) 10)))
(define else #f) ;; `evcase' needs unbound `else' !!!! <------------------ WARNING
(define else #t) ;; `evcase' needs unbound `else' !!!! <------------------ WARNING
(for-each syntax-test
(list #'(evcase)

52
collects/tests/mzscheme/mzlib.ss
View File

@ -4,56 +4,52 @@
(load-relative "loadtest.ss")
(load-relative "md5.ss")
(load-in-sandbox "md5.ss")
(load-relative "etc.ss")
(load-in-sandbox "etc.ss")
(load-relative "structlib.ss")
(load-in-sandbox "structlib.ss")
(load-relative "async-channel.ss")
(load-in-sandbox "async-channel.ss")
(load-relative "restart.ss")
(load-in-sandbox "restart.ss")
(load-relative "function.ss")
(load-in-sandbox "function.ss")
(load-relative "string.ss")
(load-in-sandbox "string.ss")
(load-relative "filelib.ss")
(load-in-sandbox "filelib.ss")
(load-relative "portlib.ss")
(load-in-sandbox "portlib.ss")
(load-relative "threadlib.ss")
(load-in-sandbox "threadlib.ss")
(load-relative "date.ss")
(load-in-sandbox "date.ss")
(load-relative "compat.ss")
(load-in-sandbox "compat.ss")
(load-relative "cmdline.ss")
(load-in-sandbox "cmdline.ss")
(load-relative "pconvert.ss")
(load-in-sandbox "pconvert.ss")
(load-relative "pretty.ss")
(load-in-sandbox "pretty.ss")
(load-relative "control.ss")
(load-in-sandbox "control.ss")
;; (load-relative "package.ss")
;; (load-in-sandbox "package.ss")
(load-relative "contract-test.ss") ;; tests scheme/contract
(load-in-sandbox "contract-test.ss") ;; tests scheme/contract
(load-relative "contract-mzlib-test.ss") ;; tests mzlib/contract
(load-in-sandbox "contract-mzlib-test.ss") ;; tests mzlib/contract
(load-relative "match-test.ss")
(load-in-sandbox "match-test.ss")
(load-relative "sandbox.ss")
(load-in-sandbox "sandbox.ss")
; Near last, because it `require's mzscheme:
; (load-relative "shared.ss") - FIXME
; (load-in-sandbox "shared.ss") - FIXME
; Also `require's mzscheme:
(load-relative "kw.ss")
(load-in-sandbox "kw.ss")
; Last - so macros are not present by accident
; Also: currently re-defines `else'!
(load-relative "macrolib.ss")
(load-in-sandbox "macrolib.ss")
(report-errs)

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

@ -76,6 +76,26 @@ transcript.
(define number-of-error-tests 0)
(define number-of-exn-tests 0)
(define (load-in-sandbox file)
(let ([e (parameterize ([(dynamic-require 'scheme/sandbox 'sandbox-security-guard)
(current-security-guard)]
[(dynamic-require 'scheme/sandbox 'sandbox-input)
current-input-port]
[(dynamic-require 'scheme/sandbox 'sandbox-output)
current-output-port]
[(dynamic-require 'scheme/sandbox 'sandbox-error-output)
current-error-port])
((dynamic-require 'scheme/sandbox 'make-evaluator) '(begin) #:requires (list 'scheme)))])
(e `(load-relative (quote ,file)))
(let ([l (e '(list number-of-tests
number-of-error-tests
number-of-exn-tests
errs))])
(set! number-of-tests (+ number-of-tests (list-ref l 0)))
(set! number-of-error-tests (+ number-of-error-tests (list-ref l 1)))
(set! number-of-exn-tests (+ number-of-exn-tests (list-ref l 2)))
(set! errs (append (list-ref l 3) errs)))))
(define (test expect fun . args)
(set! number-of-tests (add1 number-of-tests))
(printf "~s ==> " (cons fun args))

2
src/mzscheme/src/stxobj.c
View File

@ -65,8 +65,6 @@ static Scheme_Object *module_binding(int argc, Scheme_Object **argv);
static Scheme_Object *module_trans_binding(int argc, Scheme_Object **argv);
static Scheme_Object *module_templ_binding(int argc, Scheme_Object **argv);
static Scheme_Object *module_label_binding(int argc, Scheme_Object **argv);
static Scheme_Object *module_binding_pos(int argc, Scheme_Object **argv);
static Scheme_Object *module_trans_binding_pos(int argc, Scheme_Object **argv);
static Scheme_Object *syntax_src_module(int argc, Scheme_Object **argv);
static Scheme_Object *syntax_recertify(int argc, Scheme_Object **argv);