fix some tests

svn: r7847

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"))

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)])

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 ()
   

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)

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) #<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))

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

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 #&#2(1 2)))
     (match x ((box (vector _ (set! set-it))) (set-it 17)))
     x)
   #&#2(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)))

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")

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)
+  )
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

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)