;; (load "../slsets.scm")
(import slsets test)

(test-group "slsets"
  (test-group "slset<="
    (test-group "examples from srfi-1 document"
      (test-assert (slset<= '(a) '(a b a) '(a b c c)))
      (test-assert "trivial case no args" (slset<=))
      (test-assert "trivial case one arg" (slset<= '(a))))
    (test-group "negatives"
      (test-assert (not (slset<= '(a b a) '(a b c c) '(a))))
      (test-assert (not (slset<= '(a b) '(a c))))))

  (test-group "slset="
    (test-group "examples from srfi-1 document"
      (test-assert (slset= '(b e a) '(a e b) '(e e b a)))
      (test-assert "trivial case no args" (slset=))
      (test-assert "trivial case one arg" (slset= '(a))))
    (test-group "negatives"
      (test-assert (not (slset= '(b e a) '(a e b x) '(e e b a))))
      (test-assert (not (slset= '(b e a x) '(a e b) '(e e b a))))
      (test-assert (not (slset= '(b e a) '(a e b) '(e e b a x))))))

  (test-group "slset-adjoin"
    (test-group "example from srfi-1 document"
      (test '(u o i a b c d c e)
            (slset-adjoin '(a b c d c e) 'a 'e 'i 'o 'u)))
    ;; Spec says it should, so check it
    (test-group "result shares a common tail with the list argument"
      (let* ((lst '(a b c d c e))
             (result (slset-adjoin lst 'a 'x 'e 'b)))
        (test-assert (eq? lst (cdr result))))))

  (test-group "slset-union"
    (test-group "examples from srfi-1 document"
      (test '(u o i a b c d e) (slset-union '(a b c d e) '(a e i o u)))
      (test "Repeated elements in LIST1 are preserved"
            '(x a a c)
            (slset-union '(a a c) '(x a x)))
      (test "trivial case no args"
            '()
            (slset-union))
      (test "trivial case one arg"
            '(a b c)
            (slset-union '(a b c)))))

  (test-group "slset-xor"
    (test-group "examples from srfi-1 document"
      ;;(test '(d c b i o u) (slset-xor '(a b c d e) '(a e i o u)))
      ;; NOTE: The above has a peculiar ordering, but there's nothing
      ;; in the spec guaranteeing it should be like that.  We return this:
      (test '(b c d i o u) (slset-xor '(a b c d e) '(a e i o u)))
      (test "trivial case no args"
            '() (slset-xor))
      (test "trivial case one arg"
            '(a b c d e) (slset-xor '(a b c d e))))
    (test-group "extra examples"
      (test "for multiple lists, returns elements that appear in an odd number of lists"
            '(c d i u e x) (slset-xor '(a b c d e) '(a e i o u) '(b o e) '(x)))
      (test "duplicates in lists are preserved"
            '(b b c d d i o u o) (slset-xor '(a b b c d e d) '(a e i o u o)))))

  (test-group "slset-difference"
    (test-group "examples from srfi-1 document"
      (test '(b c d) (slset-difference '(a b c d e) '(a e i o u)))
      (test "trivial case"
            '(a b c) (slset-difference '(a b c))))
    (test-group "more examples"
      (test "duplicates in first list are preserved"
            '(b b c d)
            (slset-difference '(a b b c x x d x i e) '(a e i o u) '() '(x x y z z)))
      (test "empty list returns same list"
            '(a b b c d e)
            (slset-difference '(a b b c d e) '()))
      (test "empty list is empty"
            '()
            (slset-difference '() '(a b b c d e)))
      (test "empty list is still empty after other args"
            '()
            (slset-difference '() '(a b) '(c d e) '()))))

  (test-group "slset-intersection"
    (test-group "examples from srfi-1 document"
      (test '(a e) (slset-intersection '(a b c d e) '(a e i o u)))
      (test "repeated elements in LIST1 are preserved"
            '(a x a) (slset-intersection '(a x y a) '(x a x z)))
      (test "trivial case"
            '(a b c) (slset-intersection '(a b c))))
    (test-group "more examples"
      (test "multiple lists"
            '(a a) (slset-intersection '(a x b y b a) '(x a x z) '(a b)))))

  (test-group "slset-deduplicate (as per srfi-1's delete-duplicates)"
    (test-group "example from srfi-1 document"
      (test '(a b c z)
            (slset-deduplicate '(a b a c a b c z))))
    (test-group "more examples"
      (test '() (slset-deduplicate '())))))

(test-exit)