diff --git a/collects/mzlib/restart.ss b/collects/mzlib/restart.ss index 12a9d2ea86..d2e6097004 100644 --- a/collects/mzlib/restart.ss +++ b/collects/mzlib/restart.ss @@ -71,7 +71,7 @@ ,(lambda (f) (set! version? #t)) ("Show the version")] [("-i" "--repl") - ,(lambda (f) (load-scheme #t) (set! rep? #f)) + ,(lambda (f) (load-scheme #t) (set! rep? #t)) ("Run the read-eval-print loop")] [("-b" "--binary") ,(lambda (f) (error 'mzscheme "The -b flag is not supported in this mode")) diff --git a/collects/mzlib/sandbox.ss b/collects/mzlib/sandbox.ss index f371ea26c4..839fd81e34 100644 --- a/collects/mzlib/sandbox.ss +++ b/collects/mzlib/sandbox.ss @@ -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)]) diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss index 20d22f35b6..edab25b190 100644 --- a/collects/tests/mzscheme/contract-test.ss +++ b/collects/tests/mzscheme/contract-test.ss @@ -1,8 +1,6 @@ (load-relative "loadtest.ss") (Section 'contract) -(require scheme/namespace) - (parameterize ([error-print-width 200]) (let () diff --git a/collects/tests/mzscheme/kw.ss b/collects/tests/mzscheme/kw.ss index 782f49c5bf..846d4e1dfa 100644 --- a/collects/tests/mzscheme/kw.ss +++ b/collects/tests/mzscheme/kw.ss @@ -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) diff --git a/collects/tests/mzscheme/macrolib.ss b/collects/tests/mzscheme/macrolib.ss index 4af03a6ff8..e74310e2a2 100644 --- a/collects/tests/mzscheme/macrolib.ss +++ b/collects/tests/mzscheme/macrolib.ss @@ -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) # 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)) diff --git a/collects/tests/mzscheme/match/match-test.ss b/collects/tests/mzscheme/match/match-test.ss index 609bf0919e..f1cb2b1e18 100644 --- a/collects/tests/mzscheme/match/match-test.ss +++ b/collects/tests/mzscheme/match/match-test.ss @@ -1254,6 +1254,7 @@ ; set! tests ; set! for lists +#| (mytest (let ((x '(1 2 (3 4)))) (match x ((_ _ ((set! set-it) _)) (set-it 17))) @@ -1309,6 +1310,7 @@ ((_ _ (_ . _) . (set! set-it)) (set-it 17))) x) '(1 2 (3 . 4) . 17)) +|# ;; set! for vectors @@ -1332,11 +1334,13 @@ x) #&17) +#| (mytest (let ((x #&(1 2))) (match x (#&(_ (set! set-it)) (set-it 17))) x) #&(1 17)) +|# (mytest (let ((x #&#(1 2))) (match x @@ -1348,7 +1352,7 @@ ; get! tests ; get! for lists - +#| (mytest (let* ((x '(1 2 (3 4))) (f (match x @@ -1382,7 +1386,6 @@ ((_ (set! set-it) (_ _)) (set-it 17))) (f)) 17) - ;get! for improper lists (mytest (let* ((x '(1 2 (3 . 4) . 5)) @@ -1428,7 +1431,7 @@ (match x ((_ _ (_ . _) . (set! set-it)) (set-it 17))) (f)) 17) - +|# ;; get! for vectors @@ -1461,6 +1464,7 @@ (f)) 17) +#| (mytest (let* ((x #&(1 2)) (f (match x @@ -1468,7 +1472,7 @@ (match x (#&(_ (set! set-it)) (set-it 17))) (f)) 17) - +|# (mytest (let* ((x #&#(1 2)) (f diff --git a/collects/tests/mzscheme/match/plt-match-test.ss b/collects/tests/mzscheme/match/plt-match-test.ss index 77b4e1aa56..ef2704f6af 100644 --- a/collects/tests/mzscheme/match/plt-match-test.ss +++ b/collects/tests/mzscheme/match/plt-match-test.ss @@ -840,7 +840,7 @@ (and (? number? tlp327) (? even? tlp328)) (vector tlp329 ...) (list tlp330 ..3))) - #0=(list) + (list) tlp331 (or (vector tlp332 ...) (vector tlp332 ...))) `(#&(2 #3(6 (+ 1 2) #t) (#\c #t symbols)) () #\b #3(#\d #f #\b)))) @@ -1964,6 +1964,7 @@ ((list a b c) (=> fail) (if (= a 1) (fail) 'bad)) ((list a b c) (list a b c))) '(1 2 3)) +#| (mytest (let ((x '(1 2 (3 4)))) (match x ((list _ _ (list (set! set-it) _)) (set-it 17))) @@ -2009,6 +2010,7 @@ (match x ((list-rest _ _ (list-rest _ _) (set! set-it)) (set-it 17))) x) '(1 2 (3 . 4) . 17)) +|# (mytest (let ((x #2(1 2))) (match x ((vector _ (set! set-it)) (set-it 17))) x) #2(1 17)) @@ -2016,14 +2018,17 @@ (let ((x #2(1 2))) (match x ((vector (set! set-it) _) (set-it 17))) x) #2(17 2)) (mytest (let ((x #&1)) (match x ((box (set! set-it)) (set-it 17))) x) #&17) +#| (mytest (let ((x #&(1 2))) (match x ((box (list _ (set! set-it))) (set-it 17))) x) #&(1 17)) +|# (mytest (let ((x #(1 2))) (match x ((box (vector _ (set! set-it))) (set-it 17))) x) #(1 17)) +#| (mytest (let* ((x '(1 2 (3 4))) (f (match x ((list _ _ (list (get! get-it) _)) get-it)))) @@ -2103,6 +2108,7 @@ (match x ((box (vector _ (set! set-it))) (set-it 17))) (f)) 17) +|# (mytest (match #2(#3(#3(1 2 3) #3(1 2 3) #3(2 3 4)) #3(#3(1 2 3) #3(1 2 3) #3(2 3 4))) diff --git a/collects/tests/mzscheme/mzlib.ss b/collects/tests/mzscheme/mzlib.ss index d0ee3826ee..89fef77558 100644 --- a/collects/tests/mzscheme/mzlib.ss +++ b/collects/tests/mzscheme/mzlib.ss @@ -42,12 +42,13 @@ (load-relative "match-test.ss") -(load-relative "kw.ss") - (load-relative "sandbox.ss") -; Next-to-last, because it `require's mzscheme -(load-relative "shared.ss") +; Near last, because it `require's mzscheme: +; (load-relative "shared.ss") - FIXME + +; Also `require's mzscheme: +(load-relative "kw.ss") ; Last - so macros are not present by accident (load-relative "macrolib.ss") diff --git a/collects/tests/mzscheme/restart.ss b/collects/tests/mzscheme/restart.ss index 751b243138..266daa5aa6 100644 --- a/collects/tests/mzscheme/restart.ss +++ b/collects/tests/mzscheme/restart.ss @@ -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) + ) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/collects/tests/mzscheme/sandbox.ss b/collects/tests/mzscheme/sandbox.ss index 02277f5efb..8433eecdfc 100644 --- a/collects/tests/mzscheme/sandbox.ss +++ b/collects/tests/mzscheme/sandbox.ss @@ -250,7 +250,7 @@ (lambda () (printf "~s\n" '(module sandbox-test mzscheme (define x 123) (provide x)))) - 'replace) + #:exists 'replace) (set! ev (make-evaluator 'mzscheme `(,test-lib))) --eval-- x => 123 @@ -341,3 +341,5 @@ y => 789 )) + +(report-errs)