more tests of subset and set equality predicates

1 files changed, 70 insertions, 10 deletions

diff --git a/tests/srfi-113-sets.scm b/tests/srfi-113-sets.scm
index ba1d96a..61dcc82 100644
--- a/tests/srfi-113-sets.scm
+++ b/tests/srfi-113-sets.scm
@@ -21,8 +21,8 @@
 (define test-set-disjoint #f)
 (define test-set-every #f)
 (define test-set-delete #f)
-(define test-set= #f)
-(define test-set<= #f)
+(define test-set= #t)
+(define test-set<= #t)
 (define test-set< #t)
 (define test-set-intersection #f)
 
@@ -74,15 +74,17 @@
   ;; predicate of the default comparator).
   (remove-duplicates (vector-generator-of (orderable-generator))))
 
+(define (vector->set vec)
+  (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 (lambda (vec)
-                  (set-unfold cmp
-                              (cute = <> (vector-length vec))
-                              (cut vector-ref vec <>)
-                              (cut + <> 1)
-                              0))
+          (gmap vector->set
                 (unique-vector))))
 
 (define (filter-non-empty-sets set-generator)
@@ -416,11 +418,39 @@
 ;;; set=?
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(define (shuffle-vector! vec)
+  (let ((len (vector-length vec)))
+    (do ((i 0 (+ i 1)))
+        ((= i len) vec)
+      (let* ((r (random-integer len))
+             (tmp (vector-ref vec r)))
+        (vector-set! vec r (vector-ref vec i))
+        (vector-set! vec i tmp)))))
+
 (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 "sets are set= to shuffled versions of themselves"
+    (define (shuffle-set= vec)
+      (let* ((set1 (vector->set vec))
+             (set2 (vector->set (shuffle-vector! vec))))
+        (set=? set1 set2)))
+    (test-property shuffle-set= (list (vector-generator-of
+                                       (orderable-generator)))))
+  (test-group "nary set="
+    (define (nary-set= vec)
+      ;; NOTE: There is no way, as far as I know, to make sets that have
+      ;; the same of elements but are structurally different. This tries
+      ;; to do that by shuffling a list of elements.
+      (let* ((set1 (vector->set vec))
+             (set2 (vector->set (shuffle-vector! vec)))
+             (set3 (vector->set (shuffle-vector! vec)))
+             (set4 (vector->set (shuffle-vector! vec)))
+             (set5 (vector->set (shuffle-vector! vec))))
+        (set=? set1 set2 set3 set4 set5)))
+    (test-property nary-set= (list (unique-vector))))
   (test-group "set with one element deleted is not set="
     (define (not-set=? set)
       (let ((set* (set-delete set (find-some-element set))))
@@ -459,6 +489,11 @@
     (define (self-set<= set)
       (set<=? set set))
     (test-property self-set<= (list (random-sets))))
+  (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))))
@@ -469,7 +504,17 @@
     (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 (random-sets))))
+  (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))
+                                        (random-sets))))))
 
 ;;; ;;;;;;;;;;;;;;;;;;;;;;
 ;;; set<?
@@ -480,6 +525,11 @@
     (define (not-set< set)
       (not (set<? set set)))
     (test-property not-set< (list (random-sets))))
+  (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))))
@@ -491,7 +541,17 @@
       (let ((set+ (set-adjoin set (cons #f #f))))
         (set<? set set+)))
     (test-property adjoin-set< (list (filter-non-empty-sets
-                                      (random-sets))))))
+                                      (random-sets)))))
+  (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))
+                                       (random-sets))))))
 
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Set-intersection