From 2888a16d0e65bb42380e51427a6804bc557ff5ce Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Tue, 8 Apr 2008 12:29:04 +0000
Subject: [PATCH] * Move the scheme/contract tests to scheme.ss * Split
 string.ss into string-mzlib.ss which is left in mzlib.ss * Call the string.ss
 from scheme (which now has only stuff from scheme/base)

svn: r9196
---
 collects/tests/mzscheme/mzlib.ss        |  5 +-
 collects/tests/mzscheme/scheme.ss       |  2 +
 collects/tests/mzscheme/string-mzlib.ss | 94 +++++++++++++++++++++++++
 collects/tests/mzscheme/string.ss       | 93 +-----------------------
 4 files changed, 100 insertions(+), 94 deletions(-)
 create mode 100644 collects/tests/mzscheme/string-mzlib.ss

diff --git a/collects/tests/mzscheme/mzlib.ss b/collects/tests/mzscheme/mzlib.ss
index f8312e545e..6003409b7e 100644
--- a/collects/tests/mzscheme/mzlib.ss
+++ b/collects/tests/mzscheme/mzlib.ss
@@ -9,7 +9,7 @@
 (load-in-sandbox "structlib.ss")
 (load-in-sandbox "async-channel.ss")
 (load-in-sandbox "restart.ss")
-(load-in-sandbox "string.ss")
+(load-in-sandbox "string-mzlib.ss")
 (load-in-sandbox "filelib.ss")
 (load-in-sandbox "portlib.ss")
 (load-in-sandbox "threadlib.ss")
@@ -21,8 +21,7 @@
 (load-in-sandbox "control.ss")
 (load-in-sandbox "serialize.ss")
 ;; (load-in-sandbox "package.ss")
-(load-in-sandbox "contract-test.ss") ;; tests scheme/contract
-(load-in-sandbox "contract-mzlib-test.ss") ;; tests mzlib/contract
+(load-in-sandbox "contract-mzlib-test.ss")
 (load-in-sandbox "sandbox.ss")
 (load-in-sandbox "shared.ss")
 (load-in-sandbox "kw.ss")
diff --git a/collects/tests/mzscheme/scheme.ss b/collects/tests/mzscheme/scheme.ss
index 3535ca42fc..06b1d22653 100644
--- a/collects/tests/mzscheme/scheme.ss
+++ b/collects/tests/mzscheme/scheme.ss
@@ -3,5 +3,7 @@
 
 (load-relative "for.ss")
 (load-relative "list.ss")
+(load-relative "string.ss")
 (load-relative "function.ss")
 (load-relative "promise.ss")
+(load-in-sandbox "contract-test.ss")
diff --git a/collects/tests/mzscheme/string-mzlib.ss b/collects/tests/mzscheme/string-mzlib.ss
new file mode 100644
index 0000000000..e014b2c86c
--- /dev/null
+++ b/collects/tests/mzscheme/string-mzlib.ss
@@ -0,0 +1,94 @@
+
+(load-relative "loadtest.ss")
+
+(Section 'mzlib-string)
+
+(require mzlib/string)
+
+(let ([s1 (string-copy "Hello!")])
+  (string-lowercase! s1)
+  (test "hello!" 'lowercase s1)
+  (string-uppercase! s1)
+  (test "HELLO!" 'uppercase s1))
+
+(test 1 read-from-string "1")
+(test #f read-from-string "#f (2 3) (")
+(test #f read-from-string #"#f (2 3) (")
+(test 1 read-from-string "(" (lambda () 1))
+(test 1 read-from-string "(" (lambda (_) 1))
+(test '(1) read-from-string-all "1")
+(test '(#f (2 3)) read-from-string-all "#f (2 3)")
+(test '(#f (2 3)) read-from-string-all #"#f (2 3)")
+(test 1 read-from-string-all "(" (lambda () 1))
+(test 1 read-from-string-all "(" (lambda (_) 1))
+
+(test '1 eval-string "1")
+(test-values '(1 2 3) (lambda () (eval-string "1 2 3")))
+(test-values '(1 2 3) (lambda () (eval-string #"1 2 3")))
+(test-values '(1 2 3) (lambda () (eval-string "(values 1 2 3)")))
+(test-values '()      (lambda () (eval-string "(values)")))
+(test-values '(1 2 3) (lambda () (eval-string "1 (values 2 3)")))
+(test-values '(1 2 3) (lambda () (eval-string "(values 1 2) 3")))
+(test-values '(1 2 3 4 5)
+             (lambda ()
+               (eval-string "(values 1 2) 3 (values) (values 4 5)")))
+
+(let ([s (open-input-string "hello there")])
+  (test #f regexp-match/fail-without-reading #rx"not there" s)
+  (test #f regexp-match/fail-without-reading #rx"t$" s)
+  (test #f regexp-match/fail-without-reading #rx"hello there!!!" s)
+  (test "hello there" read-string 50 s))
+
+(let ([g->re-test
+       (lambda (glob . more)
+         (let ([re (apply glob->regexp glob more)])
+           (lambda xs
+             (let loop ([xs xs] [res 'unspecified])
+               (when (pair? xs)
+                 (loop (cdr xs)
+                       (if (boolean? (car xs))
+                         (car xs)
+                         (begin (test res regexp-match? re (car xs))
+                                res))))))))])
+  ((g->re-test #"foo*bar" #t #t)
+   #t #"foobar" #"foo-bar" #"foo--bar"
+   #f #"fobar" #"foo-barr" #"ffoo-bar" #".foobar")
+  ((g->re-test "foo*bar" #t #t)
+   #t "foobar" "foo-bar" "foo--bar"
+   #f "fobar" "foo-barr" "ffoo-bar" ".foobar")
+  ((g->re-test "*foo-bar" #t #t)
+   #f "foobar" "foo-barr"
+   #t "foo-bar" "-foo-bar" "foo-foo-bar" "foo-bar-foo-bar" "f.foo-bar"
+   #f ".foo-bar" ".foo-foo-bar")
+  ((g->re-test "[ab]*foo-bar" #t #t)
+   #f "foobar" "foo-barr" "foo-bar"
+   #t "afoo-bar" "b-foo-bar" "a-foo-foo-bar" "b.foo-bar"
+   #f ".afoo-bar" ".b-foo-bar")
+  ((g->re-test "[.]foo-bar" #t #t)
+   #f "foobar" "foo-barr" "foo-bar" "-foo-bar" ".foo-bar")
+  ((g->re-test "foo*bar" #t #f)
+   #t "fOobAr" "Foo-Bar" "foO--baR"
+   #f "FoBar" "fOO-baRR" "FFoo-bar" ".foobar")
+  ((g->re-test "foo*bar" #f #t)
+   #t "foobar" "foo-bar" "foo--bar"
+   #f "fobar" "foo-barr" "ffoo-bar" ".foobar")
+  ((g->re-test "*foo-bar" #f #t)
+   #f "foobar" "foo-barr"
+   #t "foo-bar" "-foo-bar" "foo-foo-bar" "foo-bar-foo-bar" "f.foo-bar"
+   #t ".foo-bar" ".foo-foo-bar")
+  ((g->re-test "[ab]*foo-bar" #f #t)
+   #f "foobar" "foo-barr" "foo-bar"
+   #t "afoo-bar" "b-foo-bar" "a-foo-foo-bar" "b.foo-bar"
+   #f ".afoo-bar" ".b-foo-bar")
+  ((g->re-test "[.]foo-bar" #f #t)
+   #f "foobar" "foo-barr" "foo-bar" "-foo-bar"
+   #t ".foo-bar")
+  ((g->re-test "foo{*}bar" #t #t)
+   #f "foo{bar" "foo{-{bar" "foo{}barr" ".foo-bar"
+   #t "foo{}bar" "foo{-}bar" "foo{{}}bar"  "foo{}{}bar")
+  ((g->re-test "^foo{[*]}bar$" #t #t #t)
+   #f "^foo{[}bar$" "^foo{[-]{bar$" "^foo{[]}barr$" ".^foo{[]}bar$"
+   #t "^foo{[]}bar$" "^foo{[-]}bar$" "^foo{[{}]}bar$"  "^foo{[]}{[]}bar$")
+  ((g->re-test "$[.]^" #t #t #t) #f "$[,]^" #t "$[.]^"))
+
+(report-errs)
diff --git a/collects/tests/mzscheme/string.ss b/collects/tests/mzscheme/string.ss
index 2f50a0af9a..8ace942d04 100644
--- a/collects/tests/mzscheme/string.ss
+++ b/collects/tests/mzscheme/string.ss
@@ -1,39 +1,9 @@
 
 (load-relative "loadtest.ss")
 
-(Section 'mzlib-string)
+(Section 'string)
 
-(require mzlib/string)
-
-(let ([s1 (string-copy "Hello!")])
-  (string-lowercase! s1)
-  (test "hello!" 'lowercase s1)
-  (string-uppercase! s1)
-  (test "HELLO!" 'uppercase s1))
-
-
-(test 1 read-from-string "1")
-(test #f read-from-string "#f (2 3) (")
-(test #f read-from-string #"#f (2 3) (")
-(test 1 read-from-string "(" (lambda () 1))
-(test 1 read-from-string "(" (lambda (_) 1))
-(test '(1) read-from-string-all "1")
-(test '(#f (2 3)) read-from-string-all "#f (2 3)")
-(test '(#f (2 3)) read-from-string-all #"#f (2 3)")
-(test 1 read-from-string-all "(" (lambda () 1))
-(test 1 read-from-string-all "(" (lambda (_) 1))
-
-
-(test '1 eval-string "1")
-(test-values '(1 2 3) (lambda () (eval-string "1 2 3")))
-(test-values '(1 2 3) (lambda () (eval-string #"1 2 3")))
-(test-values '(1 2 3) (lambda () (eval-string "(values 1 2 3)")))
-(test-values '()      (lambda () (eval-string "(values)")))
-(test-values '(1 2 3) (lambda () (eval-string "1 (values 2 3)")))
-(test-values '(1 2 3) (lambda () (eval-string "(values 1 2) 3")))
-(test-values '(1 2 3 4 5)
-             (lambda ()
-               (eval-string "(values 1 2) 3 (values) (values 4 5)")))
+;; to add when this library is there: (require scheme/string)
 
 (let ([s (list->string
 	  (let loop ([i 0])
@@ -45,13 +15,6 @@
 	regexp-replace
         (regexp-quote s) s (regexp-replace-quote (string-append "!" s "!"))))
 
-(let ([s (open-input-string "hello there")])
-  (test #f regexp-match/fail-without-reading #rx"not there" s)
-  (test #f regexp-match/fail-without-reading #rx"t$" s)
-  (test #f regexp-match/fail-without-reading #rx"hello there!!!" s)
-  (test "hello there" read-string 50 s))
-
-
 (test '("a" "b" "c") regexp-match* "[abc]" "here's a buck")
 (test '("b" "c") regexp-match* "[abc]" "here's a buck" 8)
 (test '("a") regexp-match* "[abc]" "here's a buck" 0 8)
@@ -147,56 +110,4 @@
 ;; this doesn't work (like in Emacs) because ^ matches the start pos
 ;; (test '("" "foo bar") regexp-split #rx"^" "foo bar")
 
-(let ([g->re-test
-       (lambda (glob . more)
-         (let ([re (apply glob->regexp glob more)])
-           (lambda xs
-             (let loop ([xs xs] [res 'unspecified])
-               (when (pair? xs)
-                 (loop (cdr xs)
-                       (if (boolean? (car xs))
-                         (car xs)
-                         (begin (test res regexp-match? re (car xs))
-                                res))))))))])
-  ((g->re-test #"foo*bar" #t #t)
-   #t #"foobar" #"foo-bar" #"foo--bar"
-   #f #"fobar" #"foo-barr" #"ffoo-bar" #".foobar")
-  ((g->re-test "foo*bar" #t #t)
-   #t "foobar" "foo-bar" "foo--bar"
-   #f "fobar" "foo-barr" "ffoo-bar" ".foobar")
-  ((g->re-test "*foo-bar" #t #t)
-   #f "foobar" "foo-barr"
-   #t "foo-bar" "-foo-bar" "foo-foo-bar" "foo-bar-foo-bar" "f.foo-bar"
-   #f ".foo-bar" ".foo-foo-bar")
-  ((g->re-test "[ab]*foo-bar" #t #t)
-   #f "foobar" "foo-barr" "foo-bar"
-   #t "afoo-bar" "b-foo-bar" "a-foo-foo-bar" "b.foo-bar"
-   #f ".afoo-bar" ".b-foo-bar")
-  ((g->re-test "[.]foo-bar" #t #t)
-   #f "foobar" "foo-barr" "foo-bar" "-foo-bar" ".foo-bar")
-  ((g->re-test "foo*bar" #t #f)
-   #t "fOobAr" "Foo-Bar" "foO--baR"
-   #f "FoBar" "fOO-baRR" "FFoo-bar" ".foobar")
-  ((g->re-test "foo*bar" #f #t)
-   #t "foobar" "foo-bar" "foo--bar"
-   #f "fobar" "foo-barr" "ffoo-bar" ".foobar")
-  ((g->re-test "*foo-bar" #f #t)
-   #f "foobar" "foo-barr"
-   #t "foo-bar" "-foo-bar" "foo-foo-bar" "foo-bar-foo-bar" "f.foo-bar"
-   #t ".foo-bar" ".foo-foo-bar")
-  ((g->re-test "[ab]*foo-bar" #f #t)
-   #f "foobar" "foo-barr" "foo-bar"
-   #t "afoo-bar" "b-foo-bar" "a-foo-foo-bar" "b.foo-bar"
-   #f ".afoo-bar" ".b-foo-bar")
-  ((g->re-test "[.]foo-bar" #f #t)
-   #f "foobar" "foo-barr" "foo-bar" "-foo-bar"
-   #t ".foo-bar")
-  ((g->re-test "foo{*}bar" #t #t)
-   #f "foo{bar" "foo{-{bar" "foo{}barr" ".foo-bar"
-   #t "foo{}bar" "foo{-}bar" "foo{{}}bar"  "foo{}{}bar")
-  ((g->re-test "^foo{[*]}bar$" #t #t #t)
-   #f "^foo{[}bar$" "^foo{[-]{bar$" "^foo{[]}barr$" ".^foo{[]}bar$"
-   #t "^foo{[]}bar$" "^foo{[-]}bar$" "^foo{[{}]}bar$"  "^foo{[]}{[]}bar$")
-  ((g->re-test "$[.]^" #t #t #t) #f "$[,]^" #t "$[.]^"))
-
 (report-errs)