diff options
| author | 2025-03-16 22:24:42 -0400 | |
|---|---|---|
| committer | 2025-03-16 22:24:42 -0400 | |
| commit | c19c613fa230112ce78687af5457ea0495f3e01b (patch) | |
| tree | b00778ee22dbae35a84518c5dea22b4a6ca44c76 /tests/srfi-113-sets.scm | |
| parent | reactive tests for adjoin and find (diff) | |
Tests are now listed (roughly) in the order of the procedures that they
test are listed in the SRFI, and not in a logical order.
This is because each test group can be run independently from the others.
Ideally at least one of the tests in the group is "basic" in that it
uses lists to test the properties of the procedure. However the other
tests use procedures and hence tests are circular.
This is still OK: passing the test suite is an implementation that is
meta-consistent.
Diffstat (limited to 'tests/srfi-113-sets.scm')
| -rw-r--r-- | tests/srfi-113-sets.scm | 745 |
1 files changed, 516 insertions, 229 deletions
diff --git a/tests/srfi-113-sets.scm b/tests/srfi-113-sets.scm index 5fd60b0..963ded3 100644 --- a/tests/srfi-113-sets.scm +++ b/tests/srfi-113-sets.scm @@ -17,19 +17,23 @@ (define test-set-generator-of #f) (define test-intersecting-set-generator-of #f) (define test-disjoint-set-generator-of #f) -(define test-set-every #f) (define test-set-contains #f) +(define test-set-disjoint #f) (define test-set-member #f) -(define test-set-adjoin #t) +(define test-set-adjoin #f) +(define test-set-replace #f) +(define test-set-delete #t) +(define test-set-delete-all #t) + (define test-set-find #t) -(define test-set-disjoint #f) -(define test-set-delete #f) +(define test-set-union #t) +(define test-set-difference #t) +(define test-set-every #f) (define test-set= #f) (define test-set<= #f) (define test-set< #f) (define test-set>= #f) (define test-set> #f) -(define test-set-intersection #t) (define cmp ;; The global comparator. @@ -59,18 +63,21 @@ ;;; Utility functions ;;; ;;;;;;;;;;;;;;;;;;;;;; -(define (unique-list) - ;; Return a list of unique elements (according to the equality - ;; predicate of the global comparator). - (gmap (lambda (lst) - (let loop ((list-set '()) - (lst lst)) - (cond - ((null? lst) list-set) - ((member (car lst) list-set (cut =? cmp <> <>)) - (loop list-set (cdr lst))) - (else (loop (cons (car lst) list-set) (cdr lst)))))) - (list-generator-of (orderable-generator)))) +(define unique-list + (case-lambda + (() (unique-list 100)) + ((num) + ;; Return a list of unique elements (according to the equality + ;; predicate of the global comparator). + (gmap (lambda (lst) + (let loop ((list-set '()) + (lst lst)) + (cond + ((null? lst) list-set) + ((member (car lst) list-set (cut =? cmp <> <>)) + (loop list-set (cdr lst))) + (else (loop (cons (car lst) list-set) (cdr lst)))))) + (list-generator-of (orderable-generator) num))))) (define (find-some-element s1) ;; Get some arbitrary element from the set. @@ -91,9 +98,6 @@ ;;; ;;;;;;;;;;;;;;;;;;;; ;;; Tests ;;; -;;; Tests are structured so that tests will depend on functions that -;;; were tested previously. -;;; ;;; The first part of these tests assume that `lset=` from SRFI-1 works ;;; properly. ;;; ;;;;;;;;;;;;;;;;;;;; @@ -106,18 +110,18 @@ (test-assert "not empty 4" (not (set-empty? (%set 0 1 2 3))))) (test-group "lengths" - (test-call "0" (= 0 (set-size (%set)))) - (test-call "1" (= 1 (set-size (%set 0)))) - (test-call "2" (= 2 (set-size (%set 0 1)))) - (test-call "3" (= 3 (set-size (%set 0 1 2)))) - (test-call "4" (= 4 (set-size (%set 0 1 2 3))))) + (test-assert "0" (= 0 (set-size (%set)))) + (test-assert "1" (= 1 (set-size (%set 0)))) + (test-assert "2" (= 2 (set-size (%set 0 1)))) + (test-assert "3" (= 3 (set-size (%set 0 1 2)))) + (test-assert "4" (= 4 (set-size (%set 0 1 2 3))))) (test-group "set->list" - (test-call "empty" (eq? '() (set->list (%set)))) - (test-call "1" (lset= = '(1) (set->list (%set 1)))) - (test-call "2" (lset= = '(1 2) (set->list (%set 1 2)))) - (test-call "3" (lset= = '(0 1 2) (set->list (%set 0 1 2)))) - (test-call "4" (lset= = '(0 1 2 3) (set->list (%set 0 1 2 3))))) + (test-assert "empty" (eq? '() (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))))) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Constructor tests. @@ -187,6 +191,8 @@ ;;; These generators are defined in terms of other set operations. Although ;;; it is possible to test operations of the set without these, these make ;;; the tests significantly easier to read. +;;; +;;; `set-generator-of` only depends on `list->set`. (when test-set-generator-of (test-group "set-generator-of" @@ -210,16 +216,29 @@ (define (mutually-non-disjoint sets) (every (lambda (set1) (every (lambda (set2) - (not (set-disjoint? set1 set2))) + (not (null? (lset-intersection + (cut =? cmp <...>) + (set->list set1) + (set->list set2))))) sets)) sets)) +;;; ;;;;;;;;;;;;;;;;;;;;; +;;; Advanced set generators +;;; +;;; Although these generators are implemented in terms of other set +;;; procedures, the tests here are not. +;;; ;;;;;;;;;;;;;;;;;;;;;; + (define (mutually-disjoint sets) (every (lambda (set1) (every (lambda (set2) (if (eq? set1 set2) #t - (set-disjoint? set1 set2))) + (null? (lset-intersection + (cut =? cmp <...>) + (set->list set1) + (set->list set2))))) sets)) sets)) @@ -282,234 +301,436 @@ (set-generator) 10))))) -;;; ;;;;;;;;;;;;;;;;;;;;; -;;; set-every -;;; ;;;;;;;;;;;;;;;;;;;;; - -(define (less-than-10 x) (< x 10)) - -(when test-set-every - (test-group "set-every less than 10" - (test-property (cut set-every? less-than-10 <>) - (list - (set-generator-of (gfilter - less-than-10 - (exact-integer-generator)))))) - (test-group "set-every less than 10, another element added" - (define (not-less-than-10 set) - (let ((set (set-adjoin set 100))) - (not (set-every? less-than-10 set)))) - (test-property not-less-than-10 - (list - (set-generator-of cmp - (gfilter - less-than-10 - (exact-integer-generator)) - 20))))) - ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Set-contains ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (when test-set-contains - (test-group "set-contains every element from list->set" - (define (set-contains-from lst) - (let ((set (list->set cmp lst))) - (every (cut set-contains? set <>) lst))) - (test-property set-contains-from (list (list-generator-of - (orderable-generator))))) - (test-group "set-contains every element from set-every?" - (define (set-contains-every set) - (set-every? (cut set-contains? set <>) set)) - (test-property set-contains-every (list (set-generator)))) - (test-group "set-contains? is false for elements in disjoint set" - (define (set-does-not-contain sets) - (define (set-does-not-contain? set value) - (not (set-contains? set value))) - (set-every? (cute set-does-not-contain? - (list-ref sets 1) - <>) - (list-ref sets 0))) - (test-property set-does-not-contain (list (disjoint-set-generator-of-exactly - (set-generator) - 2))))) + (test-group "set-contains" + (test-group "set-contains every element from list->set" + (define (set-contains-from lst) + (let ((set (list->set cmp lst))) + (every (cut set-contains? set <>) lst))) + (test-property set-contains-from (list (list-generator-of + (orderable-generator))))) + (test-group "set-contains every element from set-every?" + (define (set-contains-every set) + (set-every? (cut set-contains? set <>) set)) + (test-property set-contains-every (list (set-generator)))) + (test-group "set-contains? is false for elements in disjoint set" + (define (set-does-not-contain sets) + (define (set-does-not-contain? set value) + (not (set-contains? set value))) + (set-every? (cute set-does-not-contain? + (list-ref sets 1) + <>) + (list-ref sets 0))) + (test-property set-does-not-contain (list (disjoint-set-generator-of-exactly + (set-generator) + 2)))))) + +;;; ;;;;;;;;;;;;;;;;;;;;;;;;; +;;; set-disjoint? +;;; ;;;;;;;;;;;;;;;;;;;;;;;;; + +(when test-set-disjoint + (test-group "set-disjoint?" + (define (set-not-disjoint? s1 s2) + (not (set-disjoint? s1 s2))) + (test-group "sets from parts of unique list are disjoint" + (define (sets-from-unique-list lst) + (let-values (((l1 l2) (split-at! lst (floor (/ (length lst) 2))))) + (let ((set1 (list->set cmp l1)) + (set2 (list->set cmp l2))) + (set-disjoint? set1 set2)))) + (test-property sets-from-unique-list (list (gremove null? (unique-list))))) + (test-group "sets from parts of unique list with shared elements are not disjoint" + (define (sets-from-unique-list lst) + (let*-values (((el) (car lst)) + ((lst) (cdr lst)) + ((l1 l2) (split-at! lst (floor (/ (length lst) 2)))) + ((set1) (list->set cmp (cons el l1))) + ((set2) (list->set cmp (cons el l2)))) + (not (set-disjoint? set1 set2)))) + (test-property sets-from-unique-list (list (gremove null? (unique-list))))) + (test-group "non-empty sets are not disjoint from themselves" + (define (self-never-disjoint s) + (if (set-empty? s) + #t + (set-not-disjoint? s s))) + (test-property self-never-disjoint (list (set-generator)))) + (test-group "empty set is disjoint from every set" + (define (disjoint-to-empty s) + (and (set-disjoint? s (set cmp)) + (set-disjoint? (set cmp) s))) + (test-property disjoint-to-empty (list (set-generator)))) + (test-group "disjoint sets from disjoint-set-generator-of" + (define (set-disjoint-all lst) + (every (lambda (set1) + (every (lambda (set2) + (or (eq? set1 set2) + (set-disjoint? set1 set2))) + lst)) + lst)) + (test-property set-disjoint-all + (list (disjoint-set-generator-of + (set-generator) + 10)))) + (test-group "non disjoint sets from intersecting-set-generator-of" + (define (not-set-disjoint-all lst) + (every (lambda (set1) + (every (lambda (set2) + (or (eq? set1 set2) + (not (set-disjoint? set1 set2)))) + lst)) + lst)) + (test-property not-set-disjoint-all + (list (intersecting-set-generator-of + (set-generator) + 10)))))) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Set-member -;;; -;;; Defined in terms of set-every? and set-contains? ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (set-member->boolean set el) + (let ((res (set-member set el set-member->boolean))) + (not (eq? res set-member->boolean)))) + (when test-set-member (test-group "set-member" - (define (set-member-from set) - (set-every? (lambda (value) - (eq? - value - (set-member set value set-member-from))) - set)) - (test-property set-member-from (list (set-generator)))) - (test-group "not set-member" - (define (set-not-member sets) - (let ((set (list-ref sets 0)) - (traversed-set (list-ref sets 1))) - (set-every? (lambda (value) - (eq? (set-member set value set-not-member) - set-not-member)) - traversed-set))) - (test-property set-not-member (list (disjoint-set-generator-of-exactly - (set-generator) - 2))))) + (test-group "no element is set-member of empty set" + (define (not-member-of-empty el) + (not (set-member->boolean (%set) el))) + (test-property not-member-of-empty + (list (orderable-generator)))) + (test-group "list->set set-member" + (define (list-set-member lst) + (let ((set (list->set cmp lst))) + (every (cut set-member->boolean set <>) lst))) + (test-property list-set-member + (list (list-generator-of (orderable-generator))))) + (test-group "elements from set->list are set-member" + (define (list-set-member set) + (let ((lst (set->list set))) + (every (lambda (el) (set-member->boolean set el)) + lst))) + (test-property list-set-member + (list (set-generator)))) + (test-group "elements that are set-contains? are set-member" + ;; It's likely that the orderable generator generates things like + ;; booleans (which are likely to be in a set) and also inexact + ;; reals (which are highly unlikely to be in the set). + (define (set-contains-member set el) + (if (set-contains? set el) + (set-member->boolean set el) + (not (set-member->boolean set el)))) + (test-property set-contains-member + (list (set-generator) (orderable-generator)))) + (test-group "elements from disjoint set are not set-member" + (define (list-set-member sets) + (let ((traversed-set (list-ref sets 0)) + (set (list-ref sets 1))) + (set-every? (lambda (el-from-traversed) + (not (set-member->boolean set el-from-traversed))) + traversed-set))) + (test-property list-set-member + (list (disjoint-set-generator-of-exactly + (set-generator) + 2)))))) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Set-adjoin +;;; +;;; All procedures with linear-update variants use parameterized tests, i.e. +;;; the same test body runs `set-adjoin` and `set-adjoin!`. +;;; +;;; This means that all test bodys must copy sets that are modified. +;;; +;;; Note: my implementation is purely function so `set-copy` is the identity. ;;; ;;;;;;;;;;;;;;;;;;;;;;;;; -(when test-set-adjoin - (test-group "set contains after adjoin" +(define (set-adjoin-test set-adjoin) + (test-group "set contains after" (define (set-contains-after-adjoin set element) (set-contains? (set-adjoin set element) element)) (test-property set-contains-after-adjoin (list (set-generator) (orderable-generator)))) + (test-group "adjoin of each element from list->set does not change the set" + (define (set-adjoin-list lst) + (let* ((set (list->set cmp lst)) + (copy (set-copy set))) + (every (lambda (el) + (set! set (set-adjoin set el)) + (set=? set copy)) + lst))) + (test-property set-adjoin-list (list (unique-list 10)))) + (test-group "adjoin of element not in list changes set" + (define (set-adjoin-list lst) + (let-values (((l1 l2) (split-at! lst (floor (/ (length lst) 2))))) + (let* ((set (list->set cmp l1)) + (copy (set-copy set))) + (every (lambda (el) + (let ((old-size (set-size set))) + (set! set (set-adjoin set el)) + (and (set<? copy set) + (set-contains? set el) + (= (set-size set) (+ old-size 1))))) + l2)))) + (test-property set-adjoin-list (list (gremove null? (unique-list))))) + (test-group "adjoin of new element increases size by exactly 1" + (define (set-adjoin-increases set element) + (let ((old-size (set-size set)) + (new-set (set-adjoin set (cons element element)))) + (= (set-size new-set) (+ old-size 1)))) + (test-property set-adjoin-increases (list (set-generator) + (orderable-generator)))) + (test-group "adjoin of new element is idempotent" + (define (set-adjoin-increases set element) + (let* ((old-size (set-size set)) + (element (cons element element)) + (new-set (set-adjoin set element element element element))) + (= (set-size new-set) (+ old-size 1)))) + (test-property set-adjoin-increases (list (set-generator) + (orderable-generator)))) + (test-group "adjoin of arbitrary element increases size by at most one" + (define (set-adjoin-increases set element) + (let* ((old-size (set-size set)) + (new-set (set-adjoin set element element element element element))) + (and (not (negative? (- (set-size new-set) old-size))) + (<= (- (set-size new-set) old-size) 1)))) + (test-property set-adjoin-increases (list (set-generator) + (orderable-generator)))) (test-group "adjoin returns the old element" (define (set-returns-old set element) + ;; Cons cells are not a part of `orderable-generator`. (let* ((el1 (cons element element)) (el2 (cons element element)) (set (set-adjoin set el1)) (set (set-adjoin set el2))) - (eq? (set-member set el2 (lambda () #f)) el1))) + (and (eq? (set-member set el2 (lambda () set)) el1) + (eq? (set-member set el1 (lambda () set)) el1)))) (test-property set-returns-old (list (set-generator) (orderable-generator))))) -;;; ;;;;;;;;;;;;;;;;;;;;;;;; -;;; Set-find -;;; ;;;;;;;;;;;;;;;;;;;;;;;; - -(when test-set-find - (test-equal "set-find on empty set always return false" - #f - (set-find (lambda (x) #t) (set cmp) (lambda () #f))) - (test-group "set-find on non-empty set can return something" - (define (set-find-something set) - (not - (eq? (set-find (lambda (x) #t) set (lambda () set-find-something)) - set-find-something))) - (test-property set-find-something (list (gremove set-empty? - (set-generator))))) - (test-group "set-find a number" - (define (set-find-a-number set) - (let ((set (set-adjoin set 0))) - (number? (set-find number? set (lambda () set-find-a-number))))) - (test-property set-find-a-number (list (set-generator))))) - -#| -;;; ;;;;;;;;;;;;;;;;;;;; -;;; Set-count -;;; ;;;;;;;;;;;;;;;;;;;; - -#;(when test-set-count - (test-group "count traverses the whole set" - (define (count-identity set) - (= (set-count exact-integer? set) (set-size set))) - (test-property count-identity - (list (set-generator-of cmp - (exact-integer-generator))))) - ;; TODO: use sets of different types (like bytevectors and exact - ;; integers) and check set count after union. -) +(when test-set-adjoin + (test-group "set-adjoin" + (set-adjoin-test set-adjoin)) + (test-group "set-adjoin!" + (set-adjoin-test set-adjoin!))) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;; -;;; set-disjoint? +;;; Set-replace ;;; ;;;;;;;;;;;;;;;;;;;;;;;;; -(when test-set-disjoint - (let () - (define (set-not-disjoint? s1 s2) - (not (set-disjoint? s1 s2))) - (test-group "non-empty sets are not disjoint from themselves" - (define (self-never-disjoint s) - (if (set-empty? s) - #t - (set-not-disjoint? s s))) - (test-property self-never-disjoint (list (set-generator)))) - (test-group "empty set is disjoint from every set" - (define (disjoint-to-empty s) - (and (set-disjoint? s (set cmp)) - (set-disjoint? (set cmp) s))) - (test-property disjoint-to-empty (list (set-generator)))) - (test-group "sets from unique vectors are disjoint" - (define (unique-disjoint s1 s2) - (and (set-disjoint? s1 s2) (set-disjoint? s2 s1))) - (test-property (call/split unique-disjoint) - (list (split-unique-sets)))) - (test-group "including an element from two disjoint sets make them not disjoint" - (define (include-makes-not-disjoint s1 s2) - (and (not (set-disjoint? s1 s2)) - (not (set-disjoint? s2 s1)))) - (test-property (call/split - include-makes-not-disjoint) - (list (split-non-disjoint-sets)))))) +(define (set-replace-test set-replace) + ;; TODO: test with lists? + (test-group "never changes the size of a set" + (define (set-replace-size set el) + (let ((old-size (set-size set))) + (= (set-size set) (set-size (set-replace set el))))) + (test-property set-replace-size (list (set-generator) + (orderable-generator)))) + (test-group "does not affect a set that does not have the element" + (define (set-replace-does-not-affect set el) + ;; Be careful here to copy the set, because this parameterized test + ;; also tests `set-replace!`. + (let* ((copy (set-copy set)) + (new-set (set-replace set (cons el el)))) + (set=? copy new-set))) + (test-property set-replace-does-not-affect (list (set-generator) + (orderable-generator)))) + (test-group "returns the new element" + (define (set-returns-new set element) + ;; Cons cells are not a part of `orderable-generator`. + (let* ((el1 (cons element element)) + (el2 (cons element element)) + (set (set-adjoin set el1)) + (set (set-replace set el2))) + (and (eq? (set-member set el1 set) el2) + (eq? (set-member set el2 set) el2)))) + (test-property set-returns-new (list (set-generator) + (orderable-generator))))) + +(when test-set-replace + (test-group "set-replace" + (set-replace-test set-replace)) + (test-group "set-replace!" + (set-replace-test set-replace!))) ;;; ;;;;;;;;;;;;;;;;;;;;;;;; ;;; set-delete ;;; ;;;;;;;;;;;;;;;;;;;;;;;; -(when test-set-delete - (test-group "delete from empty set is always empty" +(define (set-delete-test set-delete) + (test-group "from empty set is always empty" (define (delete-from-empty element) - (set-empty? (set-delete (set cmp) element))) + (set-empty? (set-delete (%set) element))) (test-property delete-from-empty (list (orderable-generator)))) - (test-group "delete from singleton set is empty" + (test-group "from singleton set is empty" (define (delete-from-singleton element) - (set-empty? (set-delete (set cmp element) element))) + (set-empty? (set-delete (%set element) element))) (test-property delete-from-singleton (list (orderable-generator)))) - (test-group "delete of element from set keeps the rest" - (define (delete-some-element set) - (let* ((some-element (find-some-element set)) - (set* (set-delete set some-element))) - (and (not (set-contains? set* some-element)) - (set-every? (cut set-contains? set <>) set*)))) - (test-property delete-some-element - (list (filter-non-empty-sets - (set-generator))))) + (test-group "delete of elements in list" + (define (delete-from-elements lst) + (let* ((set (list->set cmp lst)) + (copy (set-copy set))) + (let loop ((lst lst) + (set set)) + (if (null? lst) + #t + (let ((set (set-delete set (car lst)))) + (and (every (cut set-contains? set <>) (cdr lst)) + (set<? set copy) + (loop (cdr lst) set))))))) + (test-property delete-from-elements (list (unique-list)))) + (test-group "of element not in set does not change the set" + (define (delete-not-in set element) + (let ((copy (set-copy set)) + (new-set (set-delete set (cons element element)))) + (set=? new-set copy))) + (test-property delete-not-in (list (set-generator) + (orderable-generator)))) + (test-group "of element from set keeps the rest" + (define (delete-element-from-set set) + (let*-values (((copy) (set-copy set)) + ((set- some-element) (delete-some-element set))) + (and (not (set-contains? set- some-element)) + (set<? set- copy) + (= (set-size set-) (- (set-size copy) 1))))) + (test-property delete-element-from-set + (list (gremove set-empty? (set-generator))))) (test-group "separate deletes are idempotent" (define (delete-idempotent set) - (let-values (((new-set el) (delete-some-element set))) - (set=? (set-delete new-set el) new-set))) + (let*-values (((set- el) (delete-some-element set)) + ((set-*) (set-delete set- el))) + (set=? set-* set-))) (test-property delete-idempotent - (list (filter-non-empty-sets - (set-generator))))) + (list (gremove set-empty? (set-generator))))) (test-group "deletes in the same line are idempotent" (define (delete-same-idem set) - (let ((el (find-some-element set))) - (set=? (set-delete set el) - (set-delete set el el el el el el)))) + (let*-values (((set- el) (delete-some-element set)) + ((set-*) (set-delete set el el el el el))) + (set=? set- set-*))) (test-property delete-same-idem - (list (filter-non-empty-sets - (set-generator))))) + (list (gremove set-empty? (set-generator))))) (test-group "delete of multiple elements from set" (define (delete-multiple set) - (let*-values (((set1 el1) (delete-some-element set)) + (let*-values (((copy) (set-copy set)) + ((set1 el1) (delete-some-element set)) ((set2 el2) (delete-some-element set1)) ((set3 el3) (delete-some-element set2))) - (set=? set3 (set-delete set el1 el2 el3)))) + (set=? set3 (set-delete copy el1 el2 el3)))) (test-property delete-multiple (list (gfilter (lambda (set) (> (set-size set) 3)) (set-generator)))))) -;;; ;;;;;;;;;;;;;;;;;;;;;;;;;; +(when test-set-delete + (test-group "set-delete" + (set-delete-test set-delete)) + (test-group "set-delete!" + (set-delete-test set-delete!))) + +;;; ;;;;;;;;;;;;;;;;;;;;;;;; +;;; set-delete-all +;;; ;;;;;;;;;;;;;;;;;;;;;;;; + +(define (set-delete-all-test set-delete-all) + (test-group "delete-all equivalent to delete" + (define (equivalent set elements) + ;; This is the regular persistent `set-delete`. + (let* ((delete (apply set-delete set elements))) + (set=? (set-delete-all set elements) delete))) + (test-property equivalent (list (set-generator) + (list-generator-of + (orderable-generator) + 64))))) + +(when test-set-delete-all + (test-group "set-delete-all" + (set-delete-all-test set-delete-all)) + (test-group "set-delete-all!" + (set-delete-all-test set-delete-all!))) + +;;; ;;;;;;;;;;;;;;;;;;;;;;;; +;;; Set-find +;;; +;;; Lots of tests use `set-find` to grab an arbitrary element from the +;;; set, so if a lot of tests are failing and you don't know why, it might +;;; be because your implementation of `set-find` is buggy. +;;; ;;;;;;;;;;;;;;;;;;;;;;;; + +(when test-set-find + (test-equal "set-find on empty set always return false" + #f + (set-find (lambda (x) #t) (set cmp) (lambda () #f))) + (test-group "set-find on non-empty set can return something" + (define (set-find-something set) + (not + (eq? (set-find (lambda (x) #t) set (lambda () set-find-something)) + set-find-something))) + (test-property set-find-something (list (gremove set-empty? + (set-generator))))) + (test-group "set-find finds an element from list->set" + (define (set-find-something set) + (member (find-some-element set) (set->list set) (cut =? cmp <...>))) + (test-property set-find-something + (list (gremove set-empty? (set-generator))))) + (test-group "set-find returns an element that is set-contains?" + (define (set-contains-something set) + (set-contains? set (find-some-element set))) + (test-property set-contains-something + (list (gremove set-empty? (set-generator))))) + (test-group "set-find returns an element that is set-member" + (define (set-member-something set) + (let ((el (find-some-element set))) + (not (eq? (set-member set el (lambda () find-some-element)) + find-some-element))) + (test-property set-member-something + (list (gremove set-empty? (set-generator))))))) + + +;;; ;;;;;;;;;;;;;;;;;;;;; +;;; set-every +;;; ;;;;;;;;;;;;;;;;;;;;; + +(define (less-than-10 x) (< x 10)) + +(when test-set-every + (test-group "set-every less than 10" + (test-property (cut set-every? less-than-10 <>) + (list + (set-generator-of (gfilter + less-than-10 + (exact-integer-generator)))))) + (test-group "set-every less than 10, another element added" + (define (not-less-than-10 set) + (let ((set (set-adjoin set 100))) + (not (set-every? less-than-10 set)))) + (test-property not-less-than-10 + (list + (set-generator-of cmp + (gfilter + less-than-10 + (exact-integer-generator)) + 20))))) +#| + +;;; ;;;;;;;;; ;;; set=? -;;; ;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;;;;;;;; -(define (shuffle-vector! vec) - (let ((len (vector-length vec))) - (do ((i 0 (+ i 1))) - ((= i len) vec) - (let* ((r (random-integer len)) +(define (shuffle-list lst) + (define (shuffle-vector! vec) + (let ((len (vector-length vec))) + (do ((i 0 (+ i 1))) + ((= i len) vec) + (let* ((r (random-integer len)) (tmp (vector-ref vec r))) - (vector-set! vec r (vector-ref vec i)) - (vector-set! vec i tmp))))) + (vector-set! vec r (vector-ref vec i)) + (vector-set! vec i tmp))))) + (vector->list (shuffle-vector! (list->vector lst)))) (when test-set= (test-group "sets are set= to themselves" @@ -517,46 +738,39 @@ (set=? set set)) (test-property always-set= (list (set-generator)))) (test-group "sets are set= to shuffled versions of themselves" - (define (shuffle-set= vec) - (let* ((set1 (vector->set vec)) - (set2 (vector->set (shuffle-vector! vec)))) + (define (shuffle-set= lst) + (let* ((set1 (list->set lst)) + (set2 (list->set (shuffle-vector! lst)))) (set=? set1 set2))) - (test-property shuffle-set= (list (vector-generator-of - (orderable-generator))))) + (test-property shuffle-set= (list (unique-list)))) (test-group "nary set=" - (define (nary-set= vec) + (define (nary-set= lst) ;; NOTE: There is no way, as far as I know, to make sets that have ;; the same of elements but are structurally different. This tries ;; to do that by shuffling a list of elements. - (let* ((set1 (vector->set vec)) - (set2 (vector->set (shuffle-vector! vec))) - (set3 (vector->set (shuffle-vector! vec))) - (set4 (vector->set (shuffle-vector! vec))) - (set5 (vector->set (shuffle-vector! vec)))) + (let* ((set1 (vector->set lst)) + (set2 (vector->set (shuffle-list lst))) + (set3 (vector->set (shuffle-list lst))) + (set4 (vector->set (shuffle-list lst))) + (set5 (vector->set (shuffle-list lst)))) (set=? set1 set2 set3 set4 set5))) - (test-property nary-set= (list (unique-vector)))) + (test-property nary-set= (list (unique-list)))) (test-group "set with one element deleted is not set=" (define (not-set=? set) - (let ((set* (set-delete set (find-some-element set)))) - (and (not (set=? set set*)) - (not (set=? set* set))))) - (test-property not-set=? (list (filter-non-empty-sets - (set-generator))))) + (let ((set- (set-delete set (find-some-element set)))) + (and (not (set=? set set-)) + (not (set=? set- set))))) + (test-property not-set=? (list (gremove set-empty? (set-generator))))) (test-group "two unique sets are not set=" - (define (unique-not-set= set1 set2) - (if (and (set-empty? set1) (set-empty? set2)) - #t - (and (not (set=? set1 set2)) - (not (set=? set2 set1))))) + (define (unique-not-set= lst) + (let-values (((s1 s2) + (make-sets-with-shared-and-disjoint lst '()))) + (if (and (set-empty? s1) (set-empty? s2)) + #t + (and (not (set=? set1 set2)) + (not (set=? set2 set1)))))) (test-property (call/split unique-not-set=) - (list (split-unique-sets)))) - (test-group "deleting an element from a set makes it not set=" - (define (delete-not-set= set) - (let ((deleted (set-delete set (find-some-element set)))) - (and (not (set=? set deleted)) - (not (set=? deleted set))))) - (test-property delete-not-set= (list (filter-non-empty-sets - (set-generator))))) + (list (unique-vector)))) (test-group "adding an element to a set makes it not set=" (define (adjoin-not-set= set) (let ((set+ (set-adjoin set (cons #f #f)))) @@ -564,6 +778,79 @@ (not (set=? set+ set))))) (test-property adjoin-not-set= (list (set-generator))))) +;;; ;;;;;;;;;;;;;;;;;;;;;;; +;;; set-union +;;; ;;;;;;;;;;;;;;;;;;;;;;; + +(when test-set-union + (test-assert "union of two empty sets is empty" + (set-empty? (set-union (%set) (%set)))) + (test-group "union of set with empty set is the same set" + (test-property (lambda (set) (set=? set (set-union (%set) set))) + (list (set-generator)))) + (test-group "union is idempotent" + (test-property (lambda (set) (set=? set (set-union set set))) + (list (set-generator)))) + (test-group "union of two sets contains elements of both" + (test-property (lambda (s1 s2) + (let ((combined (set-union s1 s2))) + (and (set<=? s1 combined) + (set<=? s2 combined)))) + (list (set-generator) (set-generator))))) + +;;; ;;;;;;;;;;;;;;;;;;;;;;;;; +;;; set-difference +;;; ;;;;;;;;;;;;;;;;;;;;;;;;; + +(when test-set-difference + (test-group "difference of set from empty is the same set" + (define (test set) + (set=? set (set-difference set (%set)))) + (test-property test (list (set-generator)))) + (test-group "difference of empty from set is empty" + (define (test set) + (set-empty? (set-difference (%set) set))) + (test-property test (list (set-generator)))) + (test-group "difference of set from disjoint set is the same set" + (define (test lst) + (let-values (((s1 s2) + (make-sets-with-shared-and-disjoint lst '()))) + (and (set=? s1 (set-difference s1 s2)) + (set=? s2 (set-difference s2 s1)))))) + (test-group "difference of set from set with shared elements" + (define (test lst) + (let-values (((disjoint1 disjoint2) + (make-sets-with-shared-and-disjoint (cdr lst) '())) + ((shared1 shared2) + (make-sets-with-shared-and-disjoint (cdr lst) (list (car lst))))) + (and (set=? disjoint1 (set-difference shared1 shared2)) + (set=? disjoint2 (set-difference shared2 shared1))))) + (test-property test (list (gremove null? (unique-list)))))) + +;;; ;;;;;;;;;;;;;;;;;;;; +;;; Set-count +;;; ;;;;;;;;;;;;;;;;;;;; + +#;(when test-set-count + (test-group "count traverses the whole set" + (define (count-identity set) + (= (set-count exact-integer? set) (set-size set))) + (test-property count-identity + (list (set-generator-of cmp + (exact-integer-generator))))) + ;; TODO: use sets of different types (like bytevectors and exact + ;; integers) and check set count after union. +) + + +;;; ;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; set=? +;;; ;;;;;;;;;;;;;;;;;;;;;;;;;; + + + + + ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; set<=? ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;; |
