start testing SRFI 113 tests

1 files changed, 71 insertions, 0 deletions

diff --git a/tests/srfi-113-sets.scm b/tests/srfi-113-sets.scm
new file mode 100644
index 0000000..edb6334
--- /dev/null
+++ b/tests/srfi-113-sets.scm
@@ -0,0 +1,71 @@
+#| Copyright 2024 Peter McGoron
+ |
+ | Licensed under the Apache License, Version 2.0 (the "License");
+ | you may not use this file except in compliance with the License.
+ | You may obtain a copy of the License at
+ |
+ |     http://www.apache.org/licenses/LICENSE-2.0
+ |
+ | Unless required by applicable law or agreed to in writing, software
+ | distributed under the License is distributed on an "AS IS" BASIS,
+ | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ | See the License for the specific language governing permissions and
+ | 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)
+             (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)))))
+
+(define (remove-duplicates generator)
+  (gmap (lambda (lst)
+          (let ((cmp (make-default-comparator)))
+            (let loop ((seen '())
+                       (lst lst))
+              (cond
+                ((null? lst) seen)
+                ((member (car lst)
+                         seen
+                         (cut =? cmp <> <>))
+                 (loop seen (cdr lst)))
+                (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))
+           (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
+                 (list (remove-duplicates
+                        (list-generator-of
+                         (orderable-generator))))))