Added tests for list-sort and vector-sort.

scheme/last-revision

@@ -1 +1 @@
-1352
+1353

scheme/run-tests.ss

@@ -34,6 +34,7 @@
         (tests parse-flonums)
         (tests io)
         (tests case-folding)
+        (tests sorting)
         )
 
 (define (test-exact-integer-sqrt)
@@ -75,4 +76,5 @@
 (test-fxlength)
 (test-bitwise-bit-count)
 (test-io)
+(test-sorting)
 (printf "Happy Happy Joy Joy\n")

scheme/tests/sorting.ss

@@ -0,0 +1,106 @@
+
+(library (tests sorting)
+  (export test-sorting)
+  (import (ikarus))
+
+  (define (permutations ls)
+    (define (rem* ls)
+      (cond
+        [(null? ls) '()]
+        [else 
+         (cons (cdr ls) 
+           (map 
+             (lambda (a) (cons (car ls) a))
+             (rem* (cdr ls))))]))
+    (cond
+      [(null? ls) '(())]
+      [else
+       (apply append
+         (map
+           (lambda (x a*) 
+             (map (lambda (a) (cons x a)) a*))
+           ls 
+           (map permutations (rem* ls))))]))
+  
+  
+  (define (test-permutations)
+    (define (fact n) 
+      (if (zero? n)
+          1
+          (* n (fact (- n 1)))))
+    (define (test ls) 
+      (let ([p* (permutations ls)])
+        (printf "Testing ~s permutations of ~s\n" 
+                (length p*) ls)
+        (unless (= (length p*) (fact (length ls)))
+          (error 'test-permutations "incorrect number of permutations"))
+        (let f ([p* p*]) 
+          (unless (null? p*) 
+            (let ([p (car p*)])
+              (when (member p (cdr p*))
+                (error 'test-permutations "duplicate" p))
+              (f (cdr p*)))))))
+    (test '())
+    (test '(1))
+    (test '(1 2))
+    (test '(1 2 3))
+    (test '(1 2 3 4))
+    (test '(1 2 3 4 5))
+    (test '(1 2 3 4 5 6)))
+  
+  
+  
+  (define (test-vector-sort)
+    (define (test ls) 
+      (let ([v1 (list->vector ls)]
+            [p* (map list->vector (permutations ls))])
+        (printf "Testing vector-sort for all ~s permutations of ~s\n" 
+                (length p*) v1)
+        (for-each
+          (lambda (p) 
+            (let* ([copy (list->vector (vector->list p))]
+                   [sv (vector-sort < p)])
+              (unless (equal? copy p) 
+                (error 'test-vector-sort "vector was mutated"))
+              (unless (equal? v1 sv)
+                (error 'test-vector-sort "failed" p sv))))
+          p*)))
+    (test '())
+    (test '(1))
+    (test '(1 2))
+    (test '(1 2 3))
+    (test '(1 2 3 4))
+    (test '(1 2 3 4 5))
+    (test '(1 2 3 4 5 6))
+    (test '(1 2 3 4 5 6 7))
+    (test '(1 2 3 4 5 6 7 8)))
+  
+  (define (test-list-sort)
+    (define (test ls) 
+      (let ([p* (permutations ls)])
+        (printf "Testing list-sort for all ~s permutations of ~s\n" 
+                (length p*) ls)
+        (for-each
+          (lambda (p) 
+            (let* ([copy (map values p)]
+                   [sv (list-sort < p)])
+              (unless (equal? copy p) 
+                (error 'test-list-sort "list was changed"))
+              (unless (equal? ls sv)
+                (error 'test-list-sort "failed" p sv))))
+          p*)))
+    (test '())
+    (test '(1))
+    (test '(1 2))
+    (test '(1 2 3))
+    (test '(1 2 3 4))
+    (test '(1 2 3 4 5))
+    (test '(1 2 3 4 5 6))
+    (test '(1 2 3 4 5 6 7))
+    (test '(1 2 3 4 5 6 7 8)))
+  
+  (define (test-sorting)
+    (test-permutations) 
+    (test-vector-sort) 
+    (test-list-sort)))
+