401a535e11
* 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
88 lines
3.3 KiB
Scheme
88 lines
3.3 KiB
Scheme
|
|
(load-relative "loadtest.ss")
|
|
|
|
(Section 'function)
|
|
|
|
(require mzlib/list)
|
|
(require mzlib/etc)
|
|
|
|
(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)
|
|
(test -1 (compose (lambda (a b) (+ a b)) (lambda (x y) (values (- y) x))) 2 3)
|
|
(test 'hi (compose (case-lambda [(x) 'bye][(y z) 'hi]) (lambda () (values 1 2))))
|
|
(test 'ok (compose (lambda () 'ok) (lambda () (values))))
|
|
(test 'ok (compose (lambda () 'ok) (lambda (w) (values))) 5)
|
|
(test-values '(1 2 3) (lambda () ((compose (lambda (x) (values x (add1 x) (+ x 2))) (lambda (y) y)) 1)))
|
|
|
|
(err/rt-test (compose 5))
|
|
(err/rt-test (compose add1 sub1 5))
|
|
(err/rt-test (compose add1 5 sub1))
|
|
(err/rt-test (compose 5 add1 sub1))
|
|
(err/rt-test ((compose add1 (lambda () (values 1 2)))) exn:application:arity?)
|
|
(err/rt-test ((compose add1 sub1)) exn:application:arity?)
|
|
(err/rt-test ((compose (lambda () 1) add1) 8) exn:application:arity?)
|
|
|
|
(arity-test compose 1 -1)
|
|
|
|
(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)))))
|
|
|
|
(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)
|
|
(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)
|
|
(test 2 (rec (f x . y) (car y)) 1 2 3)
|
|
(test 2 'no-duplications (let ([x 1]) (rec ignored (begin (set! x (+ x 1)) void)) x))
|
|
(test 'f object-name (rec (f x) x))
|
|
(test 'f object-name (rec (f x . y) x))
|
|
(test 'f object-name (rec f (lambda (x) x)))
|
|
(test (list 2) (rec (f . x) (if (= (car x) 3) (f 2) x)) 3)
|
|
|
|
(report-errs)
|