Added tests for list-sort and vector-sort.

This commit is contained in:
Abdulaziz Ghuloum 2008-01-20 17:52:19 -05:00
parent b5b558f4e6
commit fd75cfc02f
3 changed files with 109 additions and 1 deletions

View File

@ -1 +1 @@
1352
1353

View File

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

106
scheme/tests/sorting.ss Executable file
View File

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