diff --git a/scheme/last-revision b/scheme/last-revision index cdd1bbd..1b1818c 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1352 +1353 diff --git a/scheme/run-tests.ss b/scheme/run-tests.ss index 6c59063..c0a59bd 100755 --- a/scheme/run-tests.ss +++ b/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") diff --git a/scheme/tests/sorting.ss b/scheme/tests/sorting.ss new file mode 100755 index 0000000..b6afc09 --- /dev/null +++ b/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))) +