reorganized srfi 113 sets tests

1 files changed, 107 insertions, 69 deletions

diff --git a/tests/srfi-113-sets.scm b/tests/srfi-113-sets.scm
index 61dcc82..0a34272 100644
--- a/tests/srfi-113-sets.scm
+++ b/tests/srfi-113-sets.scm
@@ -21,10 +21,10 @@
 (define test-set-disjoint #f)
 (define test-set-every #f)
 (define test-set-delete #f)
-(define test-set= #t)
-(define test-set<= #t)
-(define test-set< #t)
-(define test-set-intersection #f)
+(define test-set= #f)
+(define test-set<= #f)
+(define test-set< #f)
+(define test-set-intersection #t)
 
 (define cmp (make-default-comparator))
 
@@ -48,9 +48,16 @@
                       (string-generator)
                       (bytevector-generator))))
 
+;;; ;;;;;;;;;;;;;;;;;;;;;;
+;;; Utility functions
+;;; ;;;;;;;;;;;;;;;;;;;;;;
+
 (define (remove-duplicates generator)
   ;; Remove duplicates (according to the default comparator) from vectors
   ;; made by `generator`.
+  ;; 
+  ;; TODO: This relies on SRFI-69. Just make it depend on SRFI-1 list
+  ;; procedures later, since this will only be used for testing constructors.
   (gmap (lambda (vec)
           (let* ((table (make-hash-table (cut =? cmp <> <>) hash-by-identity))
                  (n 0))
@@ -75,19 +82,15 @@
   (remove-duplicates (vector-generator-of (orderable-generator))))
 
 (define (vector->set vec)
+  ;; Convert a vector into a set.
   (set-unfold cmp
               (cute = <> (vector-length vec))
               (cut vector-ref vec <>)
               (cut + <> 1)
               0))
 
-(define (random-sets)
-  ;; Return a set of random elements.
-  (gcons* (set cmp)
-          (gmap vector->set
-                (unique-vector))))
-
 (define (filter-non-empty-sets set-generator)
+  ;; Filter a generator of sets for non-empty sets.
   (gfilter (lambda (set) (not (set-empty? set)))
            set-generator))
 
@@ -135,12 +138,18 @@
     (values (set-delete s1 element) element)))
 
 (define (split-non-disjoint-sets)
+  ;; Create a generator which generates list of two elements. The two
+  ;; elements are list whose sets are not disjoint: they have exactly
+  ;; one element in common.
   (gmap (call/split
          (lambda (s1 s2)
            (let* ((from-s1 (find-some-element s1))
                   (s2 (set-adjoin s2 from-s1)))
              (list s1 s2))))
-        (split-unique-sets)))
+        (gfilter (call/split
+                  (lambda (s1 s2)
+                    (and (not (set-empty? s1)) (not (set-empty? s2)))))
+                 (split-unique-sets))))
 
 (define
     (%set . elements)
@@ -148,6 +157,9 @@
 
 ;;; ;;;;;;;;;;;;;;;;;;;;
 ;;; Tests
+;;; 
+;;; The first part of these tests assume that `lset=` from SRFI-1 works
+;;; properly.
 ;;; ;;;;;;;;;;;;;;;;;;;;
 
 (test-group "set-empty?"
@@ -171,6 +183,20 @@
   (test-call "3" (lset= = '(0 1 2) (set->list (%set 0 1 2))))
   (test-call "4" (lset= = '(0 1 2 3) (set->list (%set 0 1 2 3)))))
 
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Constructor tests.
+;;; 
+;;; The constructor tests will test the three set constructors,
+;;; `list->set`, `set`, and `set-unfold`. These in the process test
+;;; `set->list`.
+;;; 
+;;; The SRFI does not specify what elements will be preserved in the set
+;;; when the constructors run, if they compare equal according to the
+;;; comparator.
+;;; 
+;;; There are two types of tests: tests for creation from unique vectors
+;;; and from possibly non-unique vectors.
+
 (define (test-create-with-duplicates creator)
   (lambda (vec)
     (let* ((lst (vector->list vec))
@@ -224,17 +250,53 @@
                     (cute set-unfold cmp null? car cdr <>))
                    (list (unique-vector)))))
 
+;;; ;;;;;;;;;;;;;;;;;;;;;
+;;; set-every
+;;; 
+;;; After testing constructors, `set-generator-of` should work. It's
+;;; tricky to test itself, since sets combine comparator-equal elements.
+;;; The rest of the test assumes that it works.
+;;; ;;;;;;;;;;;;;;;;;;;;;
+
+(define (less-than-10 x) (< x 10))
+
+(when test-set-every
+  (test-group "set-every less than 10"
+    (test-property (cut set-every? less-than-10 <>)
+                   (list
+                    (set-generator-of (gfilter
+                                       less-than-10
+                                       (exact-integer-generator))))))
+  (test-group "set-every less than 10, another element added"
+    (define (not-less-than-10 set)
+      (let ((set (set-adjoin set 100)))
+        (not (set-every? less-than-10 set))))
+    (test-property not-less-than-10
+                   (list
+                    (set-generator-of cmp
+                                      (gfilter
+                                       less-than-10
+                                       (exact-integer-generator))
+                                      20)))))
+
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Set-contains
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(define (set-generator)
+  (set-generator-of cmp (orderable-generator)))
+
 (when test-set-contains
-  (test-group "set-contains?"
+  (test-group "set-contains every element from list->set"
     (define (set-contains-from vec)
-      (let ((set (list->set cmp (vector->list vec))))
+      (let ((set (vector->set vec)))
         (vector-every (cut set-contains? set <>) vec)))
     (test-property set-contains-from (list (unique-vector))))
-  (test-group "not set-contains?"
+  (test-group "set-contains every element from set-every?"
+    (define (set-contains-every ste)
+      (set-every? (cut set-contains? set <>) set))
+    (test-property set-contains-every (list (set-generator))))
+  (test-group "set-contains? is false for elements in disjoint set"
     (define (set-does-not-contain vecs)
       (define (set-does-not-contain? set value)
         (not (set-contains? set value)))
@@ -245,18 +307,19 @@
 
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Set-member
+;;; 
+;;; Defined in terms of set-every? and set-contains?
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (when test-set-member
   (test-group "set-member"
-    (define (set-member-from vec)
-      (let ((set (list->set cmp (vector->list vec))))
-        (vector-every (lambda (value)
-                        (eq?
-                         value
-                         (set-member set value set-member-from)))
-                      vec)))
-    (test-property set-member-from (list (unique-vector))))
+    (define (set-member-from set)
+      (set-every? (lambda (value)
+                    (eq?
+                     value
+                     (set-member set value set-member-from)))
+                  set))
+    (test-property set-member-from (list (set-generator))))
   (test-group "not set-member"
     (define (set-not-member vecs)
       (let ((set (list->set cmp (vector->list (list-ref vecs 0))))
@@ -276,7 +339,7 @@
   (test-group "set contains after adjoin"
     (define (set-contains-after-adjoin set element)
       (set-contains? (set-adjoin set element) element))
-    (test-property set-contains-after-adjoin (list (random-sets)
+    (test-property set-contains-after-adjoin (list (set-generator)
                                                    (orderable-generator))))
   (test-group "adjoin returns the old element"
     (define (set-returns-old set element)
@@ -285,7 +348,7 @@
              (set (set-adjoin set el1))
              (set (set-adjoin set el2)))
         (eq? (set-member set el2 (lambda () #f)) el1)))
-    (test-property set-returns-old (list (random-sets)
+    (test-property set-returns-old (list (set-generator)
                                          (orderable-generator)))))
 
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;
@@ -302,12 +365,12 @@
        (eq? (set-find (lambda (x) #t) set (lambda () set-find-something))
             set-find-something)))
     (test-property set-find-something (list (filter-non-empty-sets
-                                             (random-sets)))))
+                                             (set-generator)))))
   (test-group "set-find a number"
     (define (set-find-a-number set)
       (let ((set (set-adjoin set 0)))
         (number? (set-find number? set (lambda () set-find-a-number)))))
-    (test-property set-find-a-number (list (random-sets)))))
+    (test-property set-find-a-number (list (set-generator)))))
 
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; set-disjoint?
@@ -322,12 +385,12 @@
         (if (set-empty? s)
             #t
             (set-not-disjoint? s s)))
-      (test-property self-never-disjoint (list (random-sets))))
+      (test-property self-never-disjoint (list (set-generator))))
     (test-group "empty set is disjoint from 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-property disjoint-to-empty (list (set-generator))))
     (test-group "sets from unique vectors are disjoint"
       (define (unique-disjoint s1 s2)
         (and (set-disjoint? s1 s2) (set-disjoint? s2 s1)))
@@ -341,31 +404,6 @@
                       include-makes-not-disjoint)
                      (list (split-non-disjoint-sets))))))
 
-;;; ;;;;;;;;;;;;;;;;;;;;;
-;;; set-every
-;;; ;;;;;;;;;;;;;;;;;;;;;
-
-(define (less-than-10 x) (< x 10))
-
-(when test-set-every
-  (test-group "set-every less than 10"
-    (test-property (cut set-every? less-than-10 <>)
-                   (list
-                    (set-generator-of (gfilter
-                                       less-than-10
-                                       (exact-integer-generator))))))
-  (test-group "set-every less than 10, another element added"
-    (define (not-less-than-10 set)
-      (let ((set (set-adjoin set 100)))
-        (not (set-every? less-than-10 set))))
-    (test-property not-less-than-10
-                   (list
-                    (set-generator-of cmp
-                                      (gfilter
-                                       less-than-10
-                                       (exact-integer-generator))
-                                      20)))))
-
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; set-delete
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;
@@ -387,14 +425,14 @@
              (set-every? (cut set-contains? set <>) set*))))
     (test-property delete-some-element
                    (list (filter-non-empty-sets
-                          (random-sets)))))
+                          (set-generator)))))
   (test-group "separate deletes are idempotent"
     (define (delete-idempotent set)
       (let-values (((new-set el) (delete-some-element set)))
         (set=? (set-delete new-set el) new-set)))
     (test-property delete-idempotent
                    (list (filter-non-empty-sets
-                          (random-sets)))))
+                          (set-generator)))))
   (test-group "deletes in the same line are idempotent"
     (define (delete-same-idem set)
       (let ((el (find-some-element set)))
@@ -402,7 +440,7 @@
                (set-delete set el el el el el el))))
     (test-property delete-same-idem
                    (list (filter-non-empty-sets
-                          (random-sets)))))
+                          (set-generator)))))
   (test-group "delete of multiple elements from set"
     (define (delete-multiple set)
       (let*-values (((set1 el1) (delete-some-element set))
@@ -412,7 +450,7 @@
     (test-property delete-multiple
                    (list (gfilter (lambda (set)
                                     (> (set-size set) 3))
-                                  (random-sets))))))
+                                  (set-generator))))))
 
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; set=?
@@ -431,7 +469,7 @@
   (test-group "sets are set= to themselves"
     (define (always-set= set)
       (set=? set set))
-    (test-property always-set= (list (random-sets))))
+    (test-property always-set= (list (set-generator))))
   (test-group "sets are set= to shuffled versions of themselves"
     (define (shuffle-set= vec)
       (let* ((set1 (vector->set vec))
@@ -457,7 +495,7 @@
         (and (not (set=? set set*))
              (not (set=? set* set)))))
     (test-property not-set=? (list (filter-non-empty-sets
-                                    (random-sets)))))
+                                    (set-generator)))))
   (test-group "two unique sets are not set="
     (define (unique-not-set= set1 set2)
       (if (and (set-empty? set1) (set-empty? set2))
@@ -472,13 +510,13 @@
         (and (not (set=? set deleted))
              (not (set=? deleted set)))))
     (test-property delete-not-set= (list (filter-non-empty-sets
-                                          (random-sets)))))
+                                          (set-generator)))))
   (test-group "adding an element to a set makes it not set="
     (define (adjoin-not-set= set)
       (let ((set+ (set-adjoin set (cons #f #f))))
         (and (not (set=? set set+))
              (not (set=? set+ set)))))
-    (test-property adjoin-not-set= (list (random-sets)))))
+    (test-property adjoin-not-set= (list (set-generator)))))
 
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; set<=?
@@ -488,7 +526,7 @@
   (test-group "all sets are <= to themselves"
     (define (self-set<= set)
       (set<=? set set))
-    (test-property self-set<= (list (random-sets))))
+    (test-property self-set<= (list (set-generator))))
   (test-group "all sets are <= to permutations of themselves"
     (define (random-set<= vec)
       (let* ((set (vector->set vec))
@@ -499,12 +537,12 @@
       (let ((set- (set-delete set (find-some-element set))))
         (set<=? set- set)))
     (test-property delete-set<= (list (filter-non-empty-sets
-                                       (random-sets)))))
+                                       (set-generator)))))
   (test-group "adding an element to a set makes it <="
     (define (adjoin-set<= set)
       (let ((set+ (set-adjoin set (cons #f #f))))
         (set<=? set set+)))
-    (test-property adjoin-set<= (list (random-sets))))
+    (test-property adjoin-set<= (list (set-generator))))
   (test-group "nary <="
     (define (nary-set<= set)
       (let* ((set- (delete-some-element set))
@@ -514,7 +552,7 @@
     (test-property nary-set<= (list
                                (gfilter (lambda (set)
                                           (> (set-size set) 4))
-                                        (random-sets))))))
+                                        (set-generator))))))
 
 ;;; ;;;;;;;;;;;;;;;;;;;;;;
 ;;; set<?
@@ -524,7 +562,7 @@
   (test-group "no set is < to itself"
     (define (not-set< set)
       (not (set<? set set)))
-    (test-property not-set< (list (random-sets))))
+    (test-property not-set< (list (set-generator))))
   (test-group "no set is < to a permutation of itself"
     (define (random-not-set< vec)
       (let* ((set1 (vector->set vec))
@@ -535,13 +573,13 @@
       (let ((set- (set-delete set (find-some-element set))))
         (set<? set- set)))
     (test-property delete-set< (list (filter-non-empty-sets
-                                      (random-sets)))))
+                                      (set-generator)))))
   (test-group "adjoining an element to a set makes it <"
     (define (adjoin-set< set)
       (let ((set+ (set-adjoin set (cons #f #f))))
         (set<? set set+)))
     (test-property adjoin-set< (list (filter-non-empty-sets
-                                      (random-sets)))))
+                                      (set-generator)))))
   (test-group "nary <"
     (define (nary-set< set)
       (let* ((set- (delete-some-element set))
@@ -551,7 +589,7 @@
     (test-property nary-set< (list
                               (gfilter (lambda (set)
                                          (> (set-size set) 4))
-                                       (random-sets))))))
+                                       (set-generator))))))
 
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Set-intersection