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

fix some tests

Browse Source 
svn: r7847

original commit: 8138758ea54c310f71d9cc108e432f71f5a508b6
This commit is contained in:
Matthew Flatt 2007-11-27 17:58:59 +00:00
parent 8f1da824ae
commit f98ac03136
5 changed files with 30 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/mzlib/sandbox.ss
View File

@ -368,8 +368,8 @@
[(module mod . body)
(identifier? #'mod)
(let ([mod #'mod])
(eval `(,#'require ,mod))
(module->namespace (syntax-e mod)))]
(eval `(,#'require (quote ,mod)))
(module->namespace `(quote ,(syntax-e mod))))]
[_else #f])])
(when uncovered!
(let ([get (let ([ns (current-namespace)])

2
collects/tests/mzscheme/contract-test.ss
View File

@ -1,8 +1,6 @@
(load-relative "loadtest.ss")
(Section 'contract)
(require scheme/namespace)
(parameterize ([error-print-width 200])
(let ()

5
collects/tests/mzscheme/kw.ss
View File

@ -3,7 +3,8 @@
(Section 'kw)
(require (lib "kw.ss"))
(require (lib "kw.ss")
mzscheme)
(let ()
(define-syntax t
@ -406,3 +407,5 @@
(f 1 #:a 2 #:a 3) => '(1 (#:a 2 #:a 3))))
)
(report-errs)

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

@ -24,23 +24,6 @@
[l2 (list u u u 1 1 2 1 1 2 3 5)])
(test l1 'let-plus l2)))
(require (lib "shared.ss"))
(test "((car . cdr) #(one two three four five six) #&box (list1 list2 list3 list4) #<weak-box> 3 3)"
'shared
(let ([s (open-output-string)])
(display
(shared ((a (cons 'car 'cdr))
(b (vector 'one 'two 'three 'four 'five 'six))
(c (box 'box))
(d (list 'list1 'list2 'list3 'list4))
(e (make-weak-box 'weak-box))
(f (+ 1 2))
(g 3))
(list a b c d e f g))
s)
(get-output-string s)))
(test 'hi 'local (local () 'hi))
(define x 7)
(test 6 'local (local ((define x 6)) x))

37
collects/tests/mzscheme/restart.ss
View File

@ -5,20 +5,31 @@
(Section 'restart)
(test #t restart-mzscheme #("ignore-me") values #("-qmv") void)
(test #t restart-mzscheme #("ignore-me") values #("") void)
(let ([test-in-out
(lambda (pre post in out)
(test (string-append "> " out "\n> ")
'result
(let ([s (open-output-string)])
(parameterize ([current-input-port (open-input-string in)]
[current-output-port s])
(restart-mzscheme pre values post void)
(get-output-string s)))))])
(test-in-out #("ignore-me") #("-qm") "(current-command-line-arguments)" "#0()")
(test-in-out #("") #("-qm") "'Hello" "Hello")
(test-in-out #("-G") #("-qm") "'Hello" "hello")
(test-in-out #("") #("-qmG") "'Hello" "hello"))
(lambda (pre post in out err?)
(let ([err-out (open-output-string)])
(test (if out
(string-append "> " out "\n> ")
"")
'result
(let ([s (open-output-string)])
(parameterize ([current-input-port (open-input-string in)]
[current-output-port s]
[current-error-port err-out])
(restart-mzscheme pre values post void)
(get-output-string s))))
(test err? not (string=? "" (get-output-string err-out)))))])
(test-in-out #("-q" "ignore-me") #("-i") "(current-command-line-arguments)" "#()" #f)
(test-in-out #("-q") #("-i") "'Hello" "Hello" #f)
(test-in-out #("-q") #() "'Hello" "Hello" #f)
(test-in-out #("-q") #("-e" "1") "" #f #f)
(test-in-out #("-q") #("-i" "-e" "1") "'Hello" "Hello" #f)
(test-in-out #("-q") #("-e" "z") "" #f #t)
(test-in-out #("-q") #("-e" "car" "-i") "'Hello" "Hello" #f)
(test-in-out #("-q") #("-e" "car") "" #f #f)
(test-in-out #("-q") #("-l" "scheme/list" "-e" "car") "" #f #t)
)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;