#lang scheme/base

(require "../../main.ss")

(define-struct test-case (name thunk) #:transparent)

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