; Tests for lib/set.sch
; 2000-05-18 / lth

(require 'list-set)

; searcher is memq, memv, member

(define (equivalent? a b . rest)
  (let ((searcher (if (null? rest) memq (car rest))))
    (and (every? (lambda (x) (searcher x b)) a)
         (every? (lambda (x) (searcher x a)) b))))

(or (equivalent? '(a b c) '(c b a))
    (error "equivalent? is broken."))

(define (no-duplicates? l . rest)
  (let ((searcher (if (null? rest) memq (car rest))))
    (define (loop l)
      (or (null? l)
          (and (not (searcher (car l) (cdr l)))
               (loop (cdr l)))))
    (loop l)))

(or (and (no-duplicates? '(1 2 3) memv)
         (not (no-duplicates? '(1 2 3 1) memv)))
    (error "no-duplicates is broken."))

(define (fail token . more)
  (display "Error: test failed: ")
  (display token)
  (newline)
  #f)

; ---

(or (let ((x (adjoin 'foo '())))
      (and (equivalent? x '(foo)) (no-duplicates? x)))
    (fail 'adjoin:1))
(or (let ((x (adjoin 'foo '(foo))))
      (and (equivalent? x '(foo)) (no-duplicates? x)))
    (fail 'adjoin:2))
(or (let ((x (adjoin 'foo '(a b c))))
      (and (equivalent? x '(a b c foo))
           (no-duplicates? x)))
    (fail 'adjoin:3))
(or (let ((x (adjoin 'foo '(a b foo c))))
      (and (equivalent? x '(a b c foo))
           (no-duplicates? x)))
    (fail 'adjoin:4))

(or (equivalent? (union '(a b c)) '(a b c))
    (fail 'union:1))
(or (equivalent? (union '() '()) '())
    (fail 'union:2))
(or (let ((x (union '() '(a b c))))
      (and (equivalent? x '(a b c)) (no-duplicates? x)))
    (fail 'union:3))
(or (let ((x (union '(a b c) '())))
      (and (equivalent? x '(a b c)) (no-duplicates? x)))
    (fail 'union:4))
(or (let ((x (union '(a b c) '(d c e b) '(a f b))))
      (and (equivalent? x '(a b c d e f)) (no-duplicates? x)))
    (fail 'union:5))

(or (equivalent? (intersection '(a b c)) '(a b c))
    (fail 'intersection:1))
(or (equivalent? (intersection '() '()) '())
    (fail 'intersection:2))
(or (let ((x (intersection '(a b c) '(e b d))))
      (and (equivalent? x '(b)) (no-duplicates? x)))
    (fail 'intersection:3))
(or (let ((x (intersection '(a b c) '(b c d) '(b e c))))
      (and (equivalent? x '(b c)) (no-duplicates? x)))
    (fail 'intersection:4))

(or (equivalent? (difference '() '()) '())
    (fail 'difference:1))
(or (equivalent? (difference '() '(a b c)) '())
    (fail 'difference:2))
(or (let ((x (difference '(a b c) '())))
      (and (equivalent? x '(a b c)) (no-duplicates? x)))
    (fail 'difference:3))
(or (let ((x (difference '(a b c d) '(a b d))))
      (and (equivalent? x '(c)) (no-duplicates? x)))
    (fail 'difference:4))

(or (set<=? '() '())
    (fail 'set<=?:1))
(or (set<=? '(a b c) '(a b c))
    (fail 'set<=?:2))
(or (set<=? '(a b) '(1 3 b 4 a))
    (fail 'set<=?:3))
(or (not (set<=? '(a b c) '(1 3 b 4 a)))
    (fail 'set<=?:4))
(or (set<=? '(a) '(b a) '(b c a) '(b d a c))
    (fail 'set<=?:5))
(or (not (set<=? '(a) '(b c a) '(b a) '(b d a c)))
    (fail 'set<=?:6))

(or (set=? '() '())
    (fail 'set=?:1))
(or (set=? '(a b c) '(c b a))
    (fail 'set=?:2))
(or (not (set=? '(a b c) '(a c d)))
    (fail 'set=?:3))
(or (set=? '(a b c) '(a c b) '(b a c) '(b c a) '(c a b) '(c b a))
    (fail 'set=?:4))
(or (not (set=? '(a b c) '(a c b) '(b a c) '(b c a) '(c d b) '(c b a)))
    (fail 'set=?:5))

; eof
