* Added svn:ignore to ignore test-generated files

* Renamed mzlib/contract header (distinguished from the other)
* Added "scheme.ss" to test things from the scheme collection
* Added "for.ss" to the "scheme.ss" tests, renamed the section header
  to `for'
* Added "list.ss" to test stuff from scheme/list: flatten
* Moved list tests from "function.ss" to "list.ss": foldl, foldr,
  filter, memf, assf, sort; removed bogus quicksort-mergesort test

svn: r8928

collects/tests/mzscheme/all.ss

@@ -1,5 +1,6 @@
 
 (load-relative "loadtest.ss")
+(load-relative "scheme.ss")
 (load-relative "mz.ss")
 (load-relative "mzlib.ss")
 (load-in-sandbox "boundmap-test.ss")

collects/tests/mzscheme/contract-mzlib-test.ss

@@ -7,7 +7,7 @@ of the contract library does not change over time.
 |#
 
 (load-relative "loadtest.ss")
-(Section 'contract)
+(Section 'mzlib/contract)
 
 (parameterize ([error-print-width 200])
 (let ()

collects/tests/mzscheme/for.ss

@@ -1,9 +1,7 @@
 
 (load-relative "loadtest.ss")
 
-(require mzlib/for)
+(Section 'for)
-
-(Section 'generator)
 
 (define-syntax (test-multi-generator stx)
   (syntax-case stx ()

collects/tests/mzscheme/function.ss

@@ -6,24 +6,6 @@
 (require mzlib/list)
 (require mzlib/etc)
 
-(test (list 1 2 3 4) foldl cons '() (list 4 3 2 1))
-(test (list 1 2 3 4) foldr cons '() (list 1 2 3 4))
-(test 
- (list (list 5 6) (list 3 4) (list 1 2))
- foldl (lambda (x y sofar) (cons (list x y) sofar))
- '()
- (list 1 3 5)
- (list 2 4 6))
-(test 
- (list (list 1 2) (list 3 4) (list 5 6))
- foldr (lambda (x y sofar) (cons (list x y) sofar))
- '()
- (list 1 3 5)
- (list 2 4 6))
-
-(arity-test foldl 3 -1)
-(arity-test foldr 3 -1)
-
 (test 0 (compose add1 sub1) 0)
 (test 2 (compose add1 (lambda () 1)))
 (test 5 (compose (lambda (a b) a) (lambda (x) (values (add1 x) x))) 4)
@@ -43,25 +25,6 @@
 
 (arity-test compose 1 -1)
 
-(test '(1 2 3) filter number? '(1 a 2 b 3 c d))
-(test '() filter string? '(1 a 2 b 3 c d))
-(err/rt-test (filter string? '(1 2 3 . 4)) exn:application:mismatch?)
-(err/rt-test (filter 2 '(1 2 3)))
-(err/rt-test (filter cons '(1 2 3)))
-(arity-test filter 2 2)
-
-(test '(0 1 2) memf add1 '(0 1 2))
-(test '(2 (c 17)) memf number? '((a 1) (0 x) (1 w) 2 (c 17)))
-(test '("ok" (2 .7) c) memf string? '((a 0) (0 a) (1 w) "ok" (2 .7) c))
-(err/rt-test (memf cons '((1) (2) (3))))
-(err/rt-test (memf string? '((1) (2) (3) . 4)) exn:application:mismatch?)
-
-(err/rt-test (assf add1 '(0 1 2)) exn:application:mismatch?)
-(test '(0 x) assf number? '((a 1) (0 x) (1 w) (2 r) (c 17)))
-(test '("ok" . 10) assf string? '((a 0) (0 a) (1 w) ("ok" . 10) (2 .7) c))
-(err/rt-test (assf cons '((1) (2) (3))))
-(err/rt-test (assf string? '((1) (2) (3) . 4)) exn:application:mismatch?)
-
 (test '("a" "b" "c" "c" "d" "e" "f")
       sort
       '("d" "f" "e" "c" "a" "c" "b")
@@ -108,12 +71,6 @@
               ((0 2) (1 1) (0 3))
               ((0 2) (0 3) (1 1)))))
 
-(let ([s (let loop ([n 1000])
-	   (if (zero? n)
-	       '()
-	       (cons (random 1000) (loop (sub1 n)))))])
-  (test (quicksort s <) mergesort s <))
-
 (test 3 (rec f (λ (x) 3)) 3)
 (test 3 (rec f (λ (x) x)) 3)
 (test 2 (rec f (λ (x) (if (= x 3) (f 2) x))) 3)

collects/tests/mzscheme/list.ss

@@ -0,0 +1,101 @@
+
+(load-relative "loadtest.ss")
+
+(Section 'list)
+
+(require scheme/list)
+
+(test (list 1 2 3 4) foldl cons '() (list 4 3 2 1))
+(test (list 1 2 3 4) foldr cons '() (list 1 2 3 4))
+(test (list (list 5 6) (list 3 4) (list 1 2))
+      foldl (lambda (x y sofar) (cons (list x y) sofar))
+      '()
+      (list 1 3 5)
+      (list 2 4 6))
+(test (list (list 1 2) (list 3 4) (list 5 6))
+      foldr (lambda (x y sofar) (cons (list x y) sofar))
+      '()
+      (list 1 3 5)
+      (list 2 4 6))
+
+(arity-test foldl 3 -1)
+(arity-test foldr 3 -1)
+
+(test '(1 2 3) filter number? '(1 a 2 b 3 c d))
+(test '() filter string? '(1 a 2 b 3 c d))
+(err/rt-test (filter string? '(1 2 3 . 4)) exn:application:mismatch?)
+(err/rt-test (filter 2 '(1 2 3)))
+(err/rt-test (filter cons '(1 2 3)))
+(arity-test filter 2 2)
+
+(test '(0 1 2) memf add1 '(0 1 2))
+(test '(2 (c 17)) memf number? '((a 1) (0 x) (1 w) 2 (c 17)))
+(test '("ok" (2 .7) c) memf string? '((a 0) (0 a) (1 w) "ok" (2 .7) c))
+(err/rt-test (memf cons '((1) (2) (3))))
+(err/rt-test (memf string? '((1) (2) (3) . 4)) exn:application:mismatch?)
+
+(err/rt-test (assf add1 '(0 1 2)) exn:application:mismatch?)
+(test '(0 x) assf number? '((a 1) (0 x) (1 w) (2 r) (c 17)))
+(test '("ok" . 10) assf string? '((a 0) (0 a) (1 w) ("ok" . 10) (2 .7) c))
+(err/rt-test (assf cons '((1) (2) (3))))
+(err/rt-test (assf string? '((1) (2) (3) . 4)) exn:application:mismatch?)
+
+;; ---------- sort ----------
+(test '("a" "b" "c" "c" "d" "e" "f")
+      sort
+      '("d" "f" "e" "c" "a" "c" "b")
+      string<?)
+(let ()
+  (define (car< x y) (< (car x) (car y)))
+  (define (random-list n range)
+    (let loop ([n n] [r '()])
+      (if (zero? n) r (loop (sub1 n) (cons (list (random range)) r)))))
+  (define (test-sort len times)
+    (or (zero? times)
+        (and (let* ([rand (random-list len (if (even? times) 1000000 10))]
+                    [orig< (lambda (x y) (memq y (cdr (memq x rand))))]
+                    [sorted (sort rand car<)]
+                    [l1 (reverse (cdr (reverse sorted)))]
+                    [l2 (cdr sorted)])
+               (and (= (length sorted) (length rand))
+                    (andmap (lambda (x1 x2)
+                              (and (not (car< x2 x1)) ; sorted?
+                                   (or (car< x1 x2) (orig< x1 x2)))) ; stable?
+                            l1 l2)))
+             (test-sort len (sub1 times)))))
+  (test #t test-sort    1  10)
+  (test #t test-sort    2  20)
+  (test #t test-sort    3  60)
+  (test #t test-sort    4 200)
+  (test #t test-sort    5 200)
+  (test #t test-sort   10 200)
+  (test #t test-sort  100 200)
+  (test #t test-sort 1000 200)
+  ;; test stability
+  (test '((1) (2) (3 a) (3 b) (3 c)) sort '((3 a) (1) (3 b) (2) (3 c)) car<)
+  ;; test short lists (+ stable)
+  (test '() sort '() car<)
+  (test '((1 1)) sort '((1 1)) car<)
+  (test '((1 2) (1 1)) sort '((1 2) (1 1)) car<)
+  (test '((1) (2)) sort '((2) (1)) car<)
+  (for-each (lambda (l) (test '((0 3) (1 1) (1 2)) sort l car<))
+            '(((1 1) (1 2) (0 3))
+              ((1 1) (0 3) (1 2))
+              ((0 3) (1 1) (1 2))))
+  (for-each (lambda (l) (test '((0 2) (0 3) (1 1)) sort l car<))
+            '(((1 1) (0 2) (0 3))
+              ((0 2) (1 1) (0 3))
+              ((0 2) (0 3) (1 1)))))
+
+;; ---------- flatten ----------
+(let ()
+  (define (all-sexps n)
+    (if (zero? n)
+      '(x ())
+      (let ([r (all-sexps (sub1 n))])
+        (append r (for*/list ([x r] [y r]) (cons x y))))))
+  (define sexps (all-sexps 3)) ; can use 4 on fast machines
+  (define (flat? x) (and (list? x) (andmap (lambda (x) (eq? 'x x)) x)))
+  (for ([x sexps]) (test #t flat? (flatten x))))
+
+(report-errs)

collects/tests/mzscheme/scheme.ss

@@ -0,0 +1,5 @@
+
+(load-relative "loadtest.ss")
+
+(load-relative "for.ss")
+(load-relative "list.ss")