mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
Enumeration set universe comparisons should be done with `equal?'
* module/rnrs/enums.scm (enum-set-union, enum-set-intersection, enum-set-difference): Compare enum-set universes with `equal?' to support sets generated using constructor syntax bound by `define-enumeration'. * test-suite/tests/r6rs-enums.test (enum-set-union, enum-set-intersection, enum-set-difference): New test cases for syntactically-generated sets.
This commit is contained in:
parent
a653d32a8d
commit
015a4aaedb
2 changed files with 27 additions and 9 deletions
|
@ -82,8 +82,8 @@
|
|||
(enum-set-subset? enum-set-2 enum-set-1)))
|
||||
|
||||
(define (enum-set-union enum-set-1 enum-set-2)
|
||||
(if (eq? (enum-set-universe enum-set-1)
|
||||
(enum-set-universe enum-set-2))
|
||||
(if (equal? (enum-set-universe enum-set-1)
|
||||
(enum-set-universe enum-set-2))
|
||||
(make-enum-set (enum-set-universe enum-set-1)
|
||||
(lset-union eq?
|
||||
(enum-set-set enum-set-1)
|
||||
|
@ -91,8 +91,8 @@
|
|||
(raise (make-assertion-violation))))
|
||||
|
||||
(define (enum-set-intersection enum-set-1 enum-set-2)
|
||||
(if (eq? (enum-set-universe enum-set-1)
|
||||
(enum-set-universe enum-set-2))
|
||||
(if (equal? (enum-set-universe enum-set-1)
|
||||
(enum-set-universe enum-set-2))
|
||||
(make-enum-set (enum-set-universe enum-set-1)
|
||||
(lset-intersection eq?
|
||||
(enum-set-set enum-set-1)
|
||||
|
@ -100,8 +100,8 @@
|
|||
(raise (make-assertion-violation))))
|
||||
|
||||
(define (enum-set-difference enum-set-1 enum-set-2)
|
||||
(if (eq? (enum-set-universe enum-set-1)
|
||||
(enum-set-universe enum-set-2))
|
||||
(if (equal? (enum-set-universe enum-set-1)
|
||||
(enum-set-universe enum-set-2))
|
||||
(make-enum-set (enum-set-universe enum-set-1)
|
||||
(lset-difference eq?
|
||||
(enum-set-set enum-set-1)
|
||||
|
|
|
@ -146,7 +146,13 @@
|
|||
(set1 ((enum-set-constructor universe) '(a b c)))
|
||||
(set2 ((enum-set-constructor universe) '(d e f)))
|
||||
(union (enum-set-union set1 set2)))
|
||||
(equal? (enum-set->list union) '(a b c d e f)))))
|
||||
(equal? (enum-set->list union) '(a b c d e f))))
|
||||
|
||||
(pass-if "enum-set-union operates on syntactically-generated sets"
|
||||
(let* ((set1 (make-foo-set foo))
|
||||
(set2 (make-foo-set bar))
|
||||
(union (enum-set-union set1 set2)))
|
||||
(equal? (enum-set->list union) '(foo bar)))))
|
||||
|
||||
(with-test-prefix "enum-set-intersection"
|
||||
(pass-if "&assertion raised on different universes"
|
||||
|
@ -170,7 +176,13 @@
|
|||
(set1 ((enum-set-constructor universe) '(a b c)))
|
||||
(set2 ((enum-set-constructor universe) '(d e f)))
|
||||
(intersection (enum-set-intersection set1 set2)))
|
||||
(null? (enum-set->list intersection)))))
|
||||
(null? (enum-set->list intersection))))
|
||||
|
||||
(pass-if "enum-set-intersection on syntactically-generated sets"
|
||||
(let* ((set1 (make-foo-set foo bar))
|
||||
(set2 (make-foo-set bar baz))
|
||||
(intersection (enum-set-intersection set1 set2)))
|
||||
(equal? (enum-set->list intersection) '(bar)))))
|
||||
|
||||
(with-test-prefix "enum-set-difference"
|
||||
(pass-if "&assertion raised on different universes"
|
||||
|
@ -194,7 +206,13 @@
|
|||
(set1 ((enum-set-constructor universe) '(a b c)))
|
||||
(set2 ((enum-set-constructor universe) '(a b c d)))
|
||||
(difference (enum-set-difference set1 set2)))
|
||||
(null? (enum-set->list difference)))))
|
||||
(null? (enum-set->list difference))))
|
||||
|
||||
(pass-if "enum-set-difference on syntactically-generated sets"
|
||||
(let* ((set1 (make-foo-set foo bar baz))
|
||||
(set2 (make-foo-set foo baz))
|
||||
(difference (enum-set-difference set1 set2)))
|
||||
(equal? (enum-set->list difference) '(bar)))))
|
||||
|
||||
(with-test-prefix "enum-set-complement"
|
||||
(pass-if "complement of empty set is universe"
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue