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

(define all-symbols '(a b c d e i o u x y z))
(define all-plist-entries (apply append (map symbol-plist all-symbols)))

(define (filter pred lst)
  (let lp ((lst lst)
           (res '()))
    (cond ((null? lst) (reverse res))
          ((not (pred (car lst))) (lp (cdr lst) res))
          (else (lp (cdr lst) (cons (car lst) res))))))

(define (clean? lst)
  (if (null? lst)
      #t
      (and (null? (filter (lambda (x) (not (memq x all-plist-entries))) (symbol-plist (car lst))))
           (clean? (cdr lst)))))

(test-group "slsets"
  (test-group "initially, all symbols used in any test are clean"
    (test-assert (clean? all-symbols)))

  (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 "all symbols used here still clean"
      (test-assert (clean? '(a b 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 "all symbols used here still clean"
      (test-assert (clean? '(a b e 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 "all symbols used here still clean"
      (test-assert (clean? '(a b c d e i o u x)))))

  (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 "all symbols used here still clean"
      (test-assert (clean? '(a b c d e i o u x)))))

  (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 "all symbols used here still clean"
      (test-assert (clean? '(a b c d e i o u x)))))

  (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 "all symbols used here still clean"
      (test-assert (clean? '(a b c d e i o u x y z)))))

  (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 "all symbols used here still clean"
      (test-assert (clean? '(a b c d e i o u x y z)))))

  (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-group "all symbols used here still clean"
      (test-assert (clean? '(a b c z)))))

  (test-group "finally, all symbols used in any test are still clean"
    (test-assert (clean? all-symbols))))

(test-exit)