add superset tests

1 files changed, 75 insertions, 0 deletions

diff --git a/tests/srfi-113-sets.scm b/tests/srfi-113-sets.scm
index 0a34272..8bee9ed 100644
--- a/tests/srfi-113-sets.scm
+++ b/tests/srfi-113-sets.scm
@@ -24,6 +24,8 @@
 (define test-set= #f)
 (define test-set<= #f)
 (define test-set< #f)
+(define test-set>= #t)
+(define test-set> #t)
 (define test-set-intersection #t)
 
 (define cmp (make-default-comparator))
@@ -554,6 +556,42 @@
                                           (> (set-size set) 4))
                                         (set-generator))))))
 
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; set>=?
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(when test-set>=
+  (test-group "all sets are >= to themselves"
+    (define (self-set>= set)
+      (set>=? set set))
+    (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))
+             (set2 (vector->set (shuffle-vector! vec))))
+        (set>=? set set2))))
+  (test-group "deleting an element from a set makes it >="
+    (define (delete-set>= set)
+      (let ((set- (set-delete set (find-some-element set))))
+        (set>=? set set-)))
+    (test-property delete-set>= (list (filter-non-empty-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 (set-generator))))
+  (test-group "nary >="
+    (define (nary-set>= set)
+      (let* ((set- (delete-some-element set))
+             (set-- (delete-some-element set-))
+             (set--- (delete-some-element set--)))
+        (set>=? set set- set-- set---)))
+    (test-property nary-set>= (list
+                               (gfilter (lambda (set)
+                                          (> (set-size set) 4))
+                                        (set-generator))))))
+
 ;;; ;;;;;;;;;;;;;;;;;;;;;;
 ;;; set<?
 ;;; ;;;;;;;;;;;;;;;;;;;;;;
@@ -591,6 +629,43 @@
                                          (> (set-size set) 4))
                                        (set-generator))))))
 
+;;; ;;;;;;;;;;;;;;;;;;;;;;;
+;;; set>?
+;;; ;;;;;;;;;;;;;;;;;;;;;;;
+
+(when test-set>
+  (test-group "no set is > to itself"
+    (define (not-set> set)
+      (not (set>? set set)))
+    (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))
+             (set2 (vector->set (shuffle-vector! vec))))
+        (not (set>? set1 set2)))))
+  (test-group "deleting an element from a set makes it >"
+    (define (delete-set> set)
+      (let ((set- (set-delete set (find-some-element set))))
+        (set>? set- set)))
+    (test-property delete-set> (list (filter-non-empty-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
+                                      (set-generator)))))
+  (test-group "nary >"
+    (define (nary-set> set)
+      (let* ((set- (delete-some-element set))
+             (set-- (delete-some-element set-))
+             (set--- (delete-some-element set--)))
+        (set>? set set- set-- set---)))
+    (test-property nary-set> (list
+                              (gfilter (lambda (set)
+                                         (> (set-size set) 4))
+                                       (set-generator))))))
+
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Set-intersection
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;