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