(module tests mzscheme
  (require "../../test.ss")

  (define-struct test-case (name thunk) #f)

  (define-syntax make-permutation-test
    (syntax-rules ()
      [(_ assertion (syms1 ...) (syms2 ...))
       (make-test-case "permutation test"
                       (lambda ()
                         (with-handlers ([void (lambda () #f)])
                           (eq? (list-permutation? '(syms1 ...) '(syms2 ...)) assertion))))]))

  (define all-tests
    (list
     ;; both empty:
     (make-permutation-test #t () ())

     ;; all combinations of three
     (make-permutation-test #t (a b c) (c b a))
     (make-permutation-test #t (a b c) (c a b))
     (make-permutation-test #t (a b c) (b c a))
     (make-permutation-test #t (a b c) (b a c))
     (make-permutation-test #t (a b c) (a b c))
     (make-permutation-test #t (a b c) (a c b))

     ;; with an extra element, including all duplicates:
     (make-permutation-test #f (a b c) (a b c d))
     (make-permutation-test #f (a b c) (a b c a))
     (make-permutation-test #f (a b c) (a b c b))
     (make-permutation-test #f (a b c) (a b c c))

     ;; now backwards:
     (make-permutation-test #t (c b a) (a b c))
     (make-permutation-test #t (c a b) (a b c))
     (make-permutation-test #t (b c a) (a b c))
     (make-permutation-test #t (b a c) (a b c))
     (make-permutation-test #t (a b c) (a b c))
     (make-permutation-test #t (a c b) (a b c))
     (make-permutation-test #f (a b c d) (a b c))
     (make-permutation-test #f (a b c a) (a b c))
     (make-permutation-test #f (a b c b) (a b c))
     (make-permutation-test #f (a b c c) (a b c))

     ;; one empty:
     (make-permutation-test #f (a b c) ())
     (make-permutation-test #f () (a b c))
     ))

  (define (test/text-ui tests)
    (let loop ([tests tests] [total 0] [passed 0])
      (if (null? tests)
          (printf "Total: ~a, Passed: ~a, Failed: ~a~n" total passed (- total passed))
          (let* ([next (car tests)]
                 [passed? ((test-case-thunk next))])
            (loop (cdr tests) (add1 total) (if passed? (add1 passed) passed))))))

  (test/text-ui all-tests))