add set-contains? test, remove NaNs because they cannot be used in the default comparator

1 files changed, 62 insertions, 43 deletions

diff --git a/tests/srfi-113-sets.scm b/tests/srfi-113-sets.scm
index 6cbb1ae..82da12b 100644
--- a/tests/srfi-113-sets.scm
+++ b/tests/srfi-113-sets.scm
@@ -13,24 +13,28 @@
  | limitations under the License.
  |#
 
+(define test-expensive #f)
+(define cmp (make-default-comparator))
+
 (define (orderable-generator)
   ;; Return a value that can be ordered in an obvious way.
-  (gsampling (boolean-generator)
-             (real-generator)
-             (char-generator)
-             (string-generator)
-             (bytevector-generator)))
+  (gfilter (lambda (x) (or (not (number? x))
+                           (not (nan? x))))
+           (gsampling (boolean-generator)
+                      (real-generator)
+                      (char-generator)
+                      (string-generator)
+                      (bytevector-generator))))
 
 (define (remove-duplicates generator)
   ;; Remove duplicates (according to the default comparator) from vectors
   ;; made by `generator`.
   (gmap (lambda (vec)
-          (let* ((cmp (make-default-comparator))
-                 (table (make-hash-table (cut =? cmp <> <>) hash-by-identity))
+          (let* ((table (make-hash-table (cut =? cmp <> <>) hash-by-identity))
                  (n 0))
             (vector-for-each
              (lambda (value)
-               (when (hash-table-ref/default table value #f)
+               (when (not (hash-table-ref/default table value #f))
                  (hash-table-set! table value #t)
                  (set! n (+ n 1))))
              vec)
@@ -43,8 +47,19 @@
               new-vec)))
         generator))
 
+(define (split-vector gen)
+  ;; Split vectors in half.
+  (gmap (lambda (vec)
+          (let* ((len (vector-length vec))
+                 (midpoint (floor (/ len 2))))
+            (list (vector-copy vec 0 midpoint)
+                  (vector-copy vec (+ midpoint 1) len))))
+        (gfilter (lambda (vec)
+                   (not (zero? (vector-length vec))))
+                 gen)))
+
 (define (%set . elements)
-  (apply set (make-default-comparator) elements))
+  (apply set cmp elements))
 
 ;;; ;;;;;;;;;;;;;;;;;;;;
 ;;; Tests
@@ -84,25 +99,24 @@
       (test-call "length?" (<= (set-size new-set) (length lst)))
       (test-call "subset of inserted" (lset<= equal? set-as-list lst)))))
 
-(test-group "multiple element set using `list->set` procedure"
-  (test-property (test-create-with-duplicates
-                  (cute list->set (make-default-comparator) <>))
-                 (list (vector-generator-of (orderable-generator)))))
-
-(test-group "multiple element set using `set` procedure"
-  (test-property (test-create-with-duplicates
-                  (cute apply set (make-default-comparator) <...>))
-                 (list (vector-generator-of (orderable-generator)))))
-
-(test-group "multiple element set using `set-unfold` procedure"
-  (test-property (test-create-with-duplicates
+(when test-expensive
+  (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)))))
+  (test-group "multiple element set using `set` procedure"
+    (test-property (test-create-with-duplicates
+                  (cute apply set cmp <...>))
+                   (list (vector-generator-of (orderable-generator)))))
+  (test-group "multiple element set using `set-unfold` procedure"
+    (test-property (test-create-with-duplicates
                   (cute set-unfold
-                        (make-default-comparator)
+                        cmp
                         null?
                         car
                         cdr
                         <>))
-                 (list (vector-generator-of (orderable-generator)))))
+                   (list (vector-generator-of (orderable-generator))))))
 
 (define (test-create-without-duplicates creator)
   (lambda (vec)
@@ -116,33 +130,38 @@
       (test-equal "length?" (set-size new-set) (length lst))
       (test-call "exactly inserted" (lset= equal? set-as-list lst)))))
 
-(test-group "multiple element set using `list->set` procedure, unique elements"
-  (test-property (test-create-without-duplicates
-                  (cute list->set (make-default-comparator) <>))
-                 (list (remove-duplicates
+(when test-expensive
+  (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))))))
-
-(test-group "multiple element set using `set` procedure, unique elements"
-  (test-property (test-create-without-duplicates
-                  (cute apply set (make-default-comparator) <...>))
-                 (list (remove-duplicates
+  (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))))))
-
-(test-group "multiple element set using `set-unfold` procedure, unique elements"
-  (test-property (test-create-without-duplicates
-                  (cute set-unfold
-                        (make-default-comparator)
-                        null?
-                        car
-                        cdr
-                        <>))
-                 (list (remove-duplicates
+  (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))))))
+                         (orderable-generator)))))))
 
 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 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))))))
+