set-disjoint tests

1 files changed, 60 insertions, 4 deletions

diff --git a/tests/srfi-113-sets.scm b/tests/srfi-113-sets.scm
index 0ba8f41..8bd6299 100644
--- a/tests/srfi-113-sets.scm
+++ b/tests/srfi-113-sets.scm
@@ -13,8 +13,9 @@
  | limitations under the License.
  |#
 
-(define test-constructor #t)
-(define test-set-contains #t)
+(define test-constructor #f)
+(define test-set-contains #f)
+(define test-set-disjoint #t)
 
 (define cmp (make-default-comparator))
 
@@ -60,10 +61,19 @@
         generator))
 
 (define (unique-vector)
+  ;; Return a vector of unique elements (according to the equality
+  ;; predicate of the default comparator).
   (remove-duplicates (vector-generator-of (orderable-generator))))
 
+(define (random-sets)
+  ;; Return a set of random elements.
+  (gcons* (set cmp)
+          (gmap (lambda (vec)
+                  (list->set cmp (vector->list vec)))
+                (unique-vector))))
+
 (define (split-vector gen)
-  ;; Split vectors in half.
+  ;; Split vectors in half, return it as a list.
   (gmap (lambda (vec)
           (let* ((len (vector-length vec))
                  (midpoint (floor (/ len 2))))
@@ -74,9 +84,20 @@
                  gen)))
 
 (define (split-unique-vectors)
+  ;; Generator of list of two elements, each of which is a vector. The
+  ;; vectors are disjoint.
   (split-vector (unique-vector)))
 
-(define (%set . elements)
+(define (split-unique-sets)
+  ;; Generator of a list of two elements, each of which is a set. The
+  ;; sets are disjoint.
+  (gmap (lambda (vecs)
+          (list (list->set cmp (vector->list (list-ref vecs 0)))
+                (list->set cmp (vector->list (list-ref vecs 1)))))
+        (split-unique-vectors)))
+
+(define
+    (%set . elements)
   (apply set cmp elements))
 
 ;;; ;;;;;;;;;;;;;;;;;;;;
@@ -181,3 +202,38 @@
            (test-call "does not contain" (set-does-not-contain? set value)))
          not-in)))
     (test-property set-does-not-contain (list (split-unique-vectors)))))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; set-disjoint?
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(when test-set-disjoint
+  (let ()
+    (define (set-not-disjoint? s1 s2)
+      (not (set-disjoint? s1 s2)))
+    (test-group "non-empty sets are not disjoint from themselves"
+      (define (self-never-disjoint s)
+        (if (set-empty? s)
+            #t
+            (set-not-disjoint? s s)))
+      (test-property self-never-disjoint (list (random-sets))))
+    (test-group "empty set is disjoint for every set"
+      (define (disjoint-to-empty s)
+        (and (set-disjoint? s (set cmp))
+             (set-disjoint? (set cmp) s)))
+      (test-property disjoint-to-empty (list (random-sets))))
+    (test-group "sets from unique vectors are disjoint"
+      (define (unique-disjoint sets)
+        (let ((s1 (list-ref sets 0))
+              (s2 (list-ref sets 1)))
+          (and (set-disjoint? s1 s2) (set-disjoint? s2 s1))))
+      (test-property unique-disjoint (list (split-unique-sets))))
+    #;(test-group "including an element from two disjoint sets make them not disjoint"
+        (define (include-makes-not-disjoint sets)
+          (let* ((s1 (list-ref sets 0))
+               (s2 (list-ref sets 1))
+               (some-element-from-s1 (set-find (lambda (x) #t)
+                                               s1
+                                               (lambda ()
+                                                 (error "s1 is empty" s1))))
+               (s2 (set-adjoin s2 some-element-from-s1))))))))