(module test-set mzscheme

  (require "../private/require.ss")
  (require-contracts)
  (require-schemeunit)
  (require-etc)
  (require-lists)

  (require "../private/datum.ss"
           (prefix set: "../set.ss"))

  (provide/contract
   [test-set test-suite?]
   [test-ordered-set test-suite?]
   [test-hashed-set test-suite?]
   [test-unordered-set test-suite?])

  (define (make-set-test name set)
    (make-test-suite (format "Set: ~a" name)
      (make-test-suite "accessors"
        (make-test-suite "elements"
          (make-test-case "empty"
            (assert datum-list=? (set:elements (set)) null))
          (make-test-case "1,2,3"
            (assert datum-list=? (set:elements (set 1 2 3)) (list 1 2 3))))
        (make-test-suite "empty?"
          (make-test-case "true"
            (assert-true (set:empty? (set))))
          (make-test-case "false"
            (assert-false (set:empty? (set 1 2 3)))))
        (make-test-suite "size"
          (make-test-case "empty"
            (assert = (set:size (set)) 0))
          (make-test-case "1,2,3"
            (assert = (set:size (set 1 2 3)) 3)))
        (make-test-suite "member?"
          (make-test-case "true"
            (assert-true (set:member? 2 (set 1 2 3))))
          (make-test-case "false"
            (assert-false (set:member? 4 (set 1 2 3)))))
        (make-test-suite "lookup"
          (make-test-case "a in a,b,c"
            (let* ([a "a"]
                   [b "b"]
                   [c "c"]
                   [a* (string-copy a)])
              (assert eq?
                      (set:lookup a* (set a b c))
                      a)))
          (make-test-case "a in b,c"
            (assert-false (set:lookup "a" (set "b" "c"))))
          (make-test-case "success override"
            (assert-equal?
             (set:lookup 1 (set 1 2 3)
                         (lambda () 'failure)
                         (lambda (elem) (cons 'success elem)))
             (cons 'success 1)))
          (make-test-case "failure override"
            (assert-equal?
             (set:lookup 4 (set 1 2 3)
                         (lambda () 'failure)
                         (lambda (elem) (cons 'success elem)))
             'failure)))
        (make-test-suite "select"
          (make-test-case "empty set"
            (assert-exn exn:fail? (lambda () (set:select (set)))))
          (make-test-case "singleton set"
            (assert datum=?
                    (set:select (set 1))
                    1))
          (make-test-case "1,2,3"
            (assert-true
             (let* ([elem (set:select (set 1 2 3))])
               (or (= elem 1)
                   (= elem 2)
                   (= elem 3))))))
        )
      (make-test-suite "updaters"
        (make-test-suite "insert"
          (make-test-case "1,3 + 2"
            (assert datum-list=?
                    (set:elements (set:insert 2 (set 1 3)))
                    (list 1 2 3)))
          (make-test-case "1,2,3 + 2"
            (assert datum-list=?
                    (set:elements (set:insert 2 (set 1 2 3)))
                    (list 1 2 3)))
          (make-test-case "a,b,c + a"
            (let* ([a "a"]
                   [a* (string-copy a)]
                   [elems (set:elements (set:insert a* (set a)))])
              (assert = (length elems) 1
                      "Inserting a duplicate changed set size.")
              (assert-false
               (eq? (first elems) a)
               "Inserted duplicate; original value remains.")
              (assert-true
               (eq? (first elems) a*)
               "Inserted duplicate; new value not found."))))
        (make-test-suite "remove"
          (make-test-case "present"
            (assert datum-list=?
                    (set:elements (set:remove 2 (set 1 2 3)))
                    (list 1 3)))
          (make-test-case "absent"
            (assert datum-list=?
                    (set:elements (set:remove 4 (set 1 2 3)))
                    (list 1 2 3))))
        (make-test-suite "clear"
          (make-test-case "1,2,3"
            (assert-true (set:empty? (set:clear (set 1 2 3))))))
        )
      (make-test-suite "traversals"
        (make-test-suite "fold"
          (make-test-case "1,2,3"
            (assert datum-list=?
                    (set:fold cons null (set 1 2 3))
                    (list 1 2 3))))
        (make-test-suite "map"
          (make-test-case "A,B,C"
            (assert datum-list=?
                    (set:elements (set:map symbol->string (set 'A 'B 'C)))
                    (list "A" "B" "C")))
          (make-test-case "overlap"
            (assert datum-list=?
                    (set:elements (set:map (lambda (n) (* n n)) (set -1 0 1 2)))
                    (list 0 1 4))))
        (make-test-suite "for-each"
          (make-test-case "1,2,3"
            (let* ([elems null])
              (set:for-each (lambda (elem) (set! elems (cons elem elems)))
                            (set 1 2 3))
              (assert datum-list=? elems (list 1 2 3))))
          (make-test-case "non-void"
            (set:for-each (constant #f) (set 1 2 3))))
        (make-test-suite "filter"
          (make-test-case "numbers"
            (assert datum-list=?
                    (set:elements (set:filter number?
                                              (set 1 2 3 'a 'b 'c "A" "B" "C")))
                    (list 1 2 3))))
        (make-test-suite "all?"
          (make-test-case "all"
            (assert-true (set:all? number? (set 1 2 3 4))))
          (make-test-case "some"
            (assert-false (set:all? even? (set 1 2 3 4))))
          (make-test-case "none"
            (assert-false (set:all? negative? (set 1 2 3 4)))))
        (make-test-suite "any?"
          (make-test-case "all"
            (assert-true (set:any? number? (set 1 2 3 4))))
          (make-test-case "some"
            (assert-true (set:any? even? (set 1 2 3 4))))
          (make-test-case "none"
            (assert-false (set:any? negative? (set 1 2 3 4)))))
        )
      (make-test-suite "combinations"
        (make-test-suite "union"
          (make-test-case "1,3+2,4"
            (assert datum-list=?
                    (set:elements (set:union (set 1 3) (set 2 4)))
                    (list 1 2 3 4)))
          (make-test-case "1,2,3+2,3,4"
            (assert datum-list=?
                    (set:elements (set:union (set 1 2 3) (set 2 3 4)))
                    (list 1 2 3 4)))
          (make-test-case "override"
            (let* ([a1 "a"]
                   [a2 (string-copy a1)]
                   [elems
                    (set:elements
                     (set:union (set a1) (set a2)
                                (lambda (one two)
                                  (assert eq? one a1)
                                  (assert eq? two a2)
                                  (string-copy one))))])
              (assert equal? elems (list "a"))
              (assert-false (eq? (car elems) a1))
              (assert-false (eq? (car elems) a2)))))
        (make-test-suite "intersection"
          (make-test-case "1,3&2,4"
            (assert datum-list=?
                    (set:elements (set:intersection (set 1 3) (set 2 4)))
                    null))
          (make-test-case "1,2,3&2,3,4"
            (assert datum-list=?
                    (set:elements (set:intersection (set 1 2 3) (set 2 3 4)))
                    (list 2 3)))
          (make-test-case "override"
            (let* ([b1 "b"]
                   [b2 (string-copy b1)]
                   [elems
                    (set:elements
                     (set:intersection (set "a" b1)
                                       (set b2 "c")
                                       (lambda (one two)
                                         (assert eq? one b1)
                                         (assert eq? two b2)
                                         (string-copy one))))])
              (assert equal? elems (list "b"))
              (assert-false (eq? (car elems) b1))
              (assert-false (eq? (car elems) b2)))))
        (make-test-suite "difference"
          (make-test-case "1,3-2,4"
            (assert datum-list=?
                    (set:elements (set:difference (set 1 3) (set 2 4)))
                    (list 1 3)))
          (make-test-case "1,2,3-2,3,4"
            (assert datum-list=?
                    (set:elements (set:difference (set 1 2 3) (set 2 3 4)))
                    (list 1))))
        )
      (make-test-suite "relations"
        (make-test-suite "subset?"
          (make-test-case "A subset B"
            (assert-true (set:subset? (set 1 2) (set 1 2 3))))
          (make-test-case "A equal B"
            (assert-true (set:subset? (set 1 2 3) (set 1 2 3))))
          (make-test-case "A superset B"
            (assert-false (set:subset? (set 1 2 3) (set 1 2))))
          (make-test-case "A disjoint B"
            (assert-false (set:subset? (set 1 2 3) (set 4 5 6))))
          (make-test-case "A overlaps B"
            (assert-false (set:subset? (set 1 2 3) (set 2 3 4)))))
        (make-test-suite "equal?"
          (make-test-case "A subset B"
            (assert-false (set:equal? (set 1 2) (set 1 2 3))))
          (make-test-case "A equal B"
            (assert-true (set:equal? (set 1 2 3) (set 1 2 3))))
          (make-test-case "A superset B"
            (assert-false (set:equal? (set 1 2 3) (set 1 2))))
          (make-test-case "A disjoint B"
            (assert-false (set:equal? (set 1 2 3) (set 4 5 6))))
          (make-test-case "A overlaps B"
            (assert-false (set:equal? (set 1 2 3) (set 2 3 4)))))
        )
      ))

  (define test-ordered-set
    (make-set-test "Ordered" (curry set:make-ordered datum-compare)))

  (define test-hashed-set
    (make-set-test "Hashed" (curry set:make-hashed datum-hash datum=?)))

  (define test-unordered-set
    (make-set-test "Unordered" (curry set:make-unordered datum=?)))

  (define test-set
    (make-test-suite "Sets"
      test-ordered-set
      test-hashed-set
      test-unordered-set))

  )