test set-every, set-delete, and set=?

1 files changed, 88 insertions, 6 deletions

diff --git a/tests/srfi-113-sets.scm b/tests/srfi-113-sets.scm
index adcb091..6db4b24 100644
--- a/tests/srfi-113-sets.scm
+++ b/tests/srfi-113-sets.scm
@@ -19,6 +19,9 @@
 (define test-set-adjoin #f)
 (define test-set-find #f)
 (define test-set-disjoint #f)
+(define test-set-every #t)
+(define test-set-delete #t)
+(define test-set= #t)
 (define test-set-intersection #t)
 
 (define cmp (make-default-comparator))
@@ -73,7 +76,11 @@
   ;; Return a set of random elements.
   (gcons* (set cmp)
           (gmap (lambda (vec)
-                  (list->set cmp (vector->list vec)))
+                  (set-unfold cmp
+                              (cute = <> (vector-length vec))
+                              (cut vector-ref vec <>)
+                              (cut + <> 1)
+                              0))
                 (unique-vector))))
 
 (define (filter-non-empty-sets set-generator)
@@ -111,13 +118,13 @@
                  (list->set cmp (vector->list v2)))))
         (split-unique-vectors)))
 
+(define (find-some-element s1)
+  (set-find (lambda (x) #t) s1 (lambda () (error "s1 is empty" s1))))
+
 (define (split-non-disjoint-sets)
   (gmap (call/split
          (lambda (s1 s2)
-           (let* ((from-s1 (set-find (lambda (x) #t)
-                                     s1
-                                     (lambda ()
-                                       (error "s1 is empty" s1))))
+           (let* ((from-s1 (find-some-element s1))
                   (s2 (set-adjoin s2 from-s1)))
              (list s1 s2))))
         (split-unique-sets)))
@@ -321,6 +328,77 @@
                       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
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;
+
+(when test-set-delete
+  (test-group "delete from empty set is always empty"
+    (define (delete-from-empty element)
+      (set-empty? (set-delete (set cmp) element)))
+    (test-property delete-from-empty (list (orderable-generator))))
+  (test-group "delete from singleton set is empty"
+    (define (delete-from-singleton element)
+      (set-empty? (set-delete (set cmp element) element)))
+    (test-property delete-from-singleton (list (orderable-generator))))
+  (test-group "delete of element from set keeps the rest"
+    (define (delete-some-element set)
+      (let* ((some-element (find-some-element set))
+             (set* (set-delete set some-element)))
+        (and (not (set-contains? set* some-element))
+             (set-every? (cut set-contains? set <>) set*))))
+    (test-property delete-some-element
+                   (list (filter-non-empty-sets
+                          (random-sets))))))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; set=?
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(when test-set=
+  (test-group "sets are set= to themselves"
+    (define (always-set= set)
+      (set=? set set))
+    (test-property always-set= (list (random-sets))))
+  (test-group "set with one element deleted is not set="
+    (define (not-set=? set)
+      (let ((set* (set-delete set (find-some-element set))))
+        (not (set=? set set*))))
+    (test-property not-set=? (list (filter-non-empty-sets
+                                    (random-sets)))))
+  (test-group "two unique sets are not set="
+    (define (unique-not-set= set1 set2)
+      (if (and (set-empty? set1) (set-empty? set2))
+          #t
+          (not (set=? set1 set2))))
+    (test-property (call/split unique-not-set=)
+                   (list (split-unique-sets)))))
+
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Set-intersection
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;
@@ -348,5 +426,9 @@
                      (list (split-unique-sets))))
     (test-group "non-empty intersections are non-disjoint sets"
       (test-property (call/split empty-intersection-implies-disjoint)
-                     (list (split-non-disjoint-sets))))))
+                     (list (split-non-disjoint-sets))))
+    ;; More tests:
+    ;; intersection of self is self
+    ;; intersection is subset of both sets (test subset beforehand?)
+))