test set-contains?

2 files changed, 62 insertions, 45 deletions

diff --git a/mcgoron/weight-balanced-trees/srfi/113/sets.scm b/mcgoron/weight-balanced-trees/srfi/113/sets.scm
index bc6c7bd..aa6ff47 100644
--- a/mcgoron/weight-balanced-trees/srfi/113/sets.scm
+++ b/mcgoron/weight-balanced-trees/srfi/113/sets.scm
@@ -43,13 +43,14 @@
 ;;; Predicates (besides set?)
 ;;; ;;;;;;;;;;;;;;;;;
 
+(define sentinel-value (cons #f #f))
+
 (define (set-contains? set element)
-  (let ((found? #t))
-    (search (set-element-comparator set)
-            element
-            (get-node set)
-            (lambda () (set! found? #f)))
-    found?))
+  (not (eq? (search (set-element-comparator set)
+                      element
+                      (get-node set)
+                      (lambda () sentinel-value))
+            sentinel-value)))
 
 (define (set-empty? set)
   (null? (get-node set)))
diff --git a/tests/srfi-113-sets.scm b/tests/srfi-113-sets.scm
index 82da12b..0ba8f41 100644
--- a/tests/srfi-113-sets.scm
+++ b/tests/srfi-113-sets.scm
@@ -13,15 +13,27 @@
  | limitations under the License.
  |#
 
-(define test-expensive #f)
+(define test-constructor #t)
+(define test-set-contains #t)
+
 (define cmp (make-default-comparator))
 
 (define (orderable-generator)
   ;; Return a value that can be ordered in an obvious way.
-  (gfilter (lambda (x) (or (not (number? x))
-                           (not (nan? x))))
+  ;; 
+  ;; NOTE: The default comparator will equate things like `#i0.5` and `1/2`
+  ;; or `-0.0` and `0`. This will filter only for exact integers and
+  ;; inexact non-integers.
+  (gfilter (lambda (x)
+             (if (number? x)
+                 (cond
+                   ((and (inexact? x) (integer? x)) #f)
+                   ((nan? x) #f)
+                   (else #t))
+                 #t))
            (gsampling (boolean-generator)
-                      (real-generator)
+                      (inexact-real-generator)
+                      (exact-integer-generator)
                       (char-generator)
                       (string-generator)
                       (bytevector-generator))))
@@ -47,6 +59,9 @@
               new-vec)))
         generator))
 
+(define (unique-vector)
+  (remove-duplicates (vector-generator-of (orderable-generator))))
+
 (define (split-vector gen)
   ;; Split vectors in half.
   (gmap (lambda (vec)
@@ -58,6 +73,9 @@
                    (not (zero? (vector-length vec))))
                  gen)))
 
+(define (split-unique-vectors)
+  (split-vector (unique-vector)))
+
 (define (%set . elements)
   (apply set cmp elements))
 
@@ -99,24 +117,19 @@
       (test-call "length?" (<= (set-size new-set) (length lst)))
       (test-call "subset of inserted" (lset<= equal? set-as-list lst)))))
 
-(when test-expensive
+(when test-constructor
   (test-group "multiple element set using `list->set` procedure"
     (test-property (test-create-with-duplicates
                   (cute list->set cmp <>))
-                   (list (vector-generator-of (orderable-generator)))))
+                   (list (unique-vector))))
   (test-group "multiple element set using `set` procedure"
     (test-property (test-create-with-duplicates
-                  (cute apply set cmp <...>))
-                   (list (vector-generator-of (orderable-generator)))))
+                    (cute apply set cmp <...>))
+                   (list (unique-vector))))
   (test-group "multiple element set using `set-unfold` procedure"
     (test-property (test-create-with-duplicates
-                  (cute set-unfold
-                        cmp
-                        null?
-                        car
-                        cdr
-                        <>))
-                   (list (vector-generator-of (orderable-generator))))))
+                    (cute set-unfold cmp null? car cdr <>))
+                   (list (unique-vector)))))
 
 (define (test-create-without-duplicates creator)
   (lambda (vec)
@@ -130,38 +143,41 @@
       (test-equal "length?" (set-size new-set) (length lst))
       (test-call "exactly inserted" (lset= equal? set-as-list lst)))))
 
-(when test-expensive
+(when test-constructor
   (test-group "multiple element set using `list->set` procedure, unique elements"
     (test-property (test-create-without-duplicates
-                  (cute list->set cmp <>))
-                   (list (remove-duplicates
-                        (vector-generator-of
-                         (orderable-generator))))))
+                    (cute list->set cmp <>))
+                   (list (unique-vector))))
   (test-group "multiple element set using `set` procedure, unique elements"
     (test-property (test-create-without-duplicates
-                  (cute apply set cmp <...>))
-                   (list (remove-duplicates
-                        (vector-generator-of
-                         (orderable-generator))))))
+                    (cute apply set cmp <...>))
+                   (list (unique-vector))))
   (test-group "multiple element set using `set-unfold` procedure, unique elements"
     (test-property (test-create-without-duplicates
-                  (cute set-unfold cmp null? car cdr <>))
-                   (list (remove-duplicates
-                        (vector-generator-of
-                         (orderable-generator)))))))
+                    (cute set-unfold cmp null? car cdr <>))
+                   (list (unique-vector)))))
 
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Set-contains
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(test-group "set-contains?"
-  (define (set-contains-from vec)
-    (let ((set (list->set cmp (vector->list vec))))
-      (vector-for-each
-       (lambda (value)
-         (test-call "contains" (set-contains? set value)))
-       vec)))
-  (test-property set-contains-from
-                 (list (remove-duplicates (vector-generator-of
-                                           (orderable-generator))))))
-
+(when test-set-contains
+  (test-group "set-contains?"
+    (define (set-contains-from vec)
+      (let ((set (list->set cmp (vector->list vec))))
+        (vector-for-each
+         (lambda (value)
+           (test-call "contains" (set-contains? set value)))
+         vec)))
+    (test-property set-contains-from (list (unique-vector))))
+  (test-group "not set-contains?"
+    (define (set-does-not-contain vecs)
+      (define (set-does-not-contain? set value)
+        (not (set-contains? set value)))
+      (let ((set (list->set cmp (vector->list (list-ref vecs 0))))
+          (not-in (list-ref vecs 1)))
+        (vector-for-each
+         (lambda (value)
+           (test-call "does not contain" (set-does-not-contain? set value)))
+         not-in)))
+    (test-property set-does-not-contain (list (split-unique-vectors)))))