aboutsummaryrefslogtreecommitdiffstats
path: root/tests/srfi-113-sets.scm
diff options
context:
space:
mode:
authorGravatar Peter McGoron 2025-02-16 20:33:25 -0500
committerGravatar Peter McGoron 2025-02-16 20:33:25 -0500
commit2ef07e0204877403b729083d51a479af5e5cc85e (patch)
treed1d7d0a5b334224978bca699fd5eb88f9d0838c0 /tests/srfi-113-sets.scm
parentuse test-call (diff)
use vectors instead of lists in srfi-113 tests
Diffstat (limited to 'tests/srfi-113-sets.scm')
-rw-r--r--tests/srfi-113-sets.scm59
1 files changed, 36 insertions, 23 deletions
diff --git a/tests/srfi-113-sets.scm b/tests/srfi-113-sets.scm
index 1965db6..6cbb1ae 100644
--- a/tests/srfi-113-sets.scm
+++ b/tests/srfi-113-sets.scm
@@ -22,19 +22,25 @@
(bytevector-generator)))
(define (remove-duplicates generator)
- ;; Remove duplicates (according to the default comparator) from lists
+ ;; Remove duplicates (according to the default comparator) from vectors
;; made by `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)))))))
+ (gmap (lambda (vec)
+ (let* ((cmp (make-default-comparator))
+ (table (make-hash-table (cut =? cmp <> <>) hash-by-identity))
+ (n 0))
+ (vector-for-each
+ (lambda (value)
+ (when (hash-table-ref/default table value #f)
+ (hash-table-set! table value #t)
+ (set! n (+ n 1))))
+ vec)
+ (let ((new-vec (make-vector n))
+ (n 0))
+ (hash-table-walk table
+ (lambda (key _)
+ (vector-set! new-vec n key)
+ (set! n (+ n 1))))
+ new-vec)))
generator))
(define (%set . elements)
@@ -66,8 +72,9 @@
(test-call "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))
+ (lambda (vec)
+ (let* ((lst (vector->list vec))
+ (new-set (creator lst))
(set-as-list (set->list new-set)))
(test-assert "set?" (set? new-set))
(if (null? lst)
@@ -80,12 +87,12 @@
(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)))))
+ (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 (list-generator-of (orderable-generator)))))
+ (list (vector-generator-of (orderable-generator)))))
(test-group "multiple element set using `set-unfold` procedure"
(test-property (test-create-with-duplicates
@@ -95,11 +102,12 @@
car
cdr
<>))
- (list (list-generator-of (orderable-generator)))))
+ (list (vector-generator-of (orderable-generator)))))
(define (test-create-without-duplicates creator)
- (lambda (lst)
- (let* ((new-set (creator lst))
+ (lambda (vec)
+ (let* ((lst (vector->list vec))
+ (new-set (creator lst))
(set-as-list (set->list new-set)))
(test-assert "set?" (set? new-set))
(test-assert "empty?" (if (null? lst)
@@ -112,14 +120,14 @@
(test-property (test-create-without-duplicates
(cute list->set (make-default-comparator) <>))
(list (remove-duplicates
- (list-generator-of
+ (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
- (list-generator-of
+ (vector-generator-of
(orderable-generator))))))
(test-group "multiple element set using `set-unfold` procedure, unique elements"
@@ -131,5 +139,10 @@
cdr
<>))
(list (remove-duplicates
- (list-generator-of
- (orderable-generator)))))) \ No newline at end of file
+ (vector-generator-of
+ (orderable-generator))))))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Set-contains
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+