more set-intersection tests

2 files changed, 37 insertions, 7 deletions

diff --git a/mcgoron/weight-balanced-trees/srfi/113/sets.scm b/mcgoron/weight-balanced-trees/srfi/113/sets.scm
index c9085cf..b65b56e 100644
--- a/mcgoron/weight-balanced-trees/srfi/113/sets.scm
+++ b/mcgoron/weight-balanced-trees/srfi/113/sets.scm
@@ -342,7 +342,11 @@
 (define set-union (convert-binary-procedure union))
 (define set-union! set-union)
 
-(define set-intersection (convert-binary-procedure intersection))
+(define set-intersection (convert-binary-procedure
+                          (lambda (cmp node1 node2)
+                            (if (eq? node1 node2)
+                                node1
+                                (intersection cmp node1 node2)))))
 (define set-intersection! set-intersection)
 
 (define set-difference (convert-binary-procedure difference))
diff --git a/tests/srfi-113-sets.scm b/tests/srfi-113-sets.scm
index 8bee9ed..344f3bd 100644
--- a/tests/srfi-113-sets.scm
+++ b/tests/srfi-113-sets.scm
@@ -24,8 +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>= #f)
+(define test-set> #f)
 (define test-set-intersection #t)
 
 (define cmp (make-default-comparator))
@@ -374,6 +374,21 @@
         (number? (set-find number? set (lambda () set-find-a-number)))))
     (test-property set-find-a-number (list (set-generator)))))
 
+;;; ;;;;;;;;;;;;;;;;;;;;
+;;; Set-count
+;;; ;;;;;;;;;;;;;;;;;;;;
+
+#;(when test-set-count
+  (test-group "count traverses the whole set"
+    (define (count-identity set)
+      (= (set-count exact-integer? set) (set-size set)))
+    (test-property count-identity
+                   (list (set-generator-of cmp
+                                           (exact-integer-generator)))))
+  ;; TODO: use sets of different types (like bytevectors and exact
+  ;; integers) and check set count after union.
+)
+
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; set-disjoint?
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -694,8 +709,19 @@
     (test-group "non-empty intersections are non-disjoint sets"
       (test-property (call/split empty-intersection-implies-disjoint)
                      (list (split-non-disjoint-sets))))
-    ;; More tests:
-    ;; intersection of self is self
-    ;; intersection is subset of both sets (test subset beforehand?)
-))
+    (test-group "intersection of self is self"
+      (define (intersection-self set)
+        (set=? (set-intersection set set) set))
+      (test-property intersection-self (list (set-generator))))
+    (test-group "intersection is always subset of both sets"
+      (define (intersection-subset set1 set2)
+        (let ((i (set-intersection set1 set2)))
+          (and (set<=? i set1)
+               (set<=? i set2))))
+      (test-property (call/split intersection-subset)
+                     (list (gsampling
+                            (split-non-disjoint-sets)
+                            (gmap list
+                                  (set-generator)
+                                  (set-generator))))))))