tests for different constructors

1 files changed, 97 insertions, 29 deletions

diff --git a/tests/srfi-113-sets.scm b/tests/srfi-113-sets.scm
index edb6334..a43ca33 100644
--- a/tests/srfi-113-sets.scm
+++ b/tests/srfi-113-sets.scm
@@ -13,33 +13,17 @@
  | limitations under the License.
  |#
 
-(import (mcgoron weight-balanced-trees srfi 113 sets)
-        (srfi 252)
-        (srfi 64))
-
 (define (orderable-generator)
   ;; Return a value that can be ordered in an obvious way.
-  (gsampling #;(boolean-generator)
+  (gsampling (boolean-generator)
              (real-generator)
-             #;(char-generator)
-             #;(string-generator)
-             #;(bytevector-generator)))
-
-(test-group "multiple element set using `set` procedure"
-  (define (multiple-element-set lst)
-    (let* ((new-set (apply set (make-default-comparator) lst))
-           (set-as-list (set->list new-set)))
-      (test-assert "set?" (set? new-set))
-      (test-assert "empty?" (if (null? lst)
-                                (set-empty? new-set)
-                                (not (set-empty? new-set))))
-      ;; The new-set will remove duplicates.
-      (test-assert "length?" (<= (set-size new-set) (length lst)))
-      (test-assert "subset of inserted" (lset<= equal? set-as-list lst))))
-  (test-property multiple-element-set
-                 (list (list-generator-of (orderable-generator)))))
+             (char-generator)
+             (string-generator)
+             (bytevector-generator)))
 
 (define (remove-duplicates generator)
+  ;; Remove duplicates (according to the default comparator) from lists
+  ;; made by `generator`.
   (gmap (lambda (lst)
           (let ((cmp (make-default-comparator)))
             (let loop ((seen '())
@@ -53,19 +37,103 @@
                 (else (loop (cons (car lst) seen) (cdr lst)))))))
         generator))
 
-(test-group "multiple element set using `set` procedure, unique elements"
-  (define (multiple-element-set lst)
-    (let* ((new-set (apply set (make-default-comparator) lst))
+(define (%set . elements)
+  (apply set (make-default-comparator) elements))
+
+;;; ;;;;;;;;;;;;;;;;;;;;
+;;; Tests
+;;; ;;;;;;;;;;;;;;;;;;;;
+
+(test-group "set-empty?"
+  (test-assert "empty" (set-empty? (%set)))
+  (test-assert "not empty 1"
+               (not (set-empty? (%set 0))))
+  (test-assert "not empty 2"
+               (not (set-empty? (%set 0 1))))
+  (test-assert "not empty 3"
+               (not (set-empty? (%set 0 1 2))))
+  (test-assert "not empty 4"
+               (not (set-empty? (%set 0 1 2 3)))))
+
+(test-group "lengths"
+  (test-equal "0" 0 (set-size (%set)))
+  (test-equal "1" 1 (set-size (%set 0)))
+  (test-equal "2" 2 (set-size (%set 0 1)))
+  (test-equal "3" 3 (set-size (%set 0 1 2)))
+  (test-equal "4" 4 (set-size (%set 0 1 2 3))))
+
+(test-group "set->list"
+  (test-equal "empty" '() (set->list (%set)))
+  (test-assert "1" (lset= = '(1) (set->list (%set 1))))
+  (test-assert "2" (lset= = '(1 2) (set->list (%set 1 2))))
+  (test-assert "3" (lset= = '(0 1 2) (set->list (%set 0 1 2))))
+  (test-assert "4" (lset= = '(0 1 2 3) (set->list (%set 0 1 2 3)))))
+
+(define (test-create-with-duplicates creator)
+  (lambda (lst)
+    (let* ((new-set (creator lst))
+           (set-as-list (set->list new-set)))
+      (test-assert "set?" (set? new-set))
+      (test-assert "empty?" (if (null? lst)
+                                (set-empty? new-set)
+                                (not (set-empty? new-set))))
+      ;; The new-set will remove duplicates.
+      (test-assert "length?" (<= (set-size new-set) (length lst)))
+      (test-assert "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 (list-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 (list-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)
+                        null?
+                        car
+                        cdr
+                        <>))
+                 (list (list-generator-of (orderable-generator)))))
+
+(define (test-create-without-duplicates creator)
+  (lambda (lst)
+    (let* ((new-set (creator lst))
            (set-as-list (set->list new-set)))
       (test-assert "set?" (set? new-set))
       (test-assert "empty?" (if (null? lst)
                                 (set-empty? new-set)
                                 (not (set-empty? new-set))))
-      (dynamic-property-set! 'set set-as-list)
-      (dynamic-property-set! 'list lst)
       (test-equal "length?" (set-size new-set) (length lst))
-      (test-assert "exactly inserted" (lset= equal? set-as-list lst))))
-  (test-property multiple-element-set
+      (test-assert "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
+                        (list-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
                         (list-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
+                        (list-generator-of
+                         (orderable-generator))))))
\ No newline at end of file