Implement set equality.

This commit is contained in:
Dominik Pantůček 2023-04-11 13:49:28 +02:00
parent 30664d10f8
commit 575c1cdb3d
7 changed files with 44 additions and 7 deletions

View file

@ -389,6 +389,13 @@ Returns a new lset instance containing elements present both in
Returns a new lset instance from ```ls1``` with all elements in Returns a new lset instance from ```ls1``` with all elements in
```ls2``` removed from it. ```ls2``` removed from it.
(lset=? ls1 ls2)
* ```ls1``` - lset instance
* ```ls2``` - lset instance
Returns true if the sets contain exactly the same values.
### String ### String
(import util-string) (import util-string)

View file

@ -93,7 +93,8 @@ listing.o: listing.import.scm
listing.import.scm: $(LISTING-SOURCES) listing.import.scm: $(LISTING-SOURCES)
UTIL-DICT-LIST-SOURCES=util-dict-list.scm testing.import.scm \ UTIL-DICT-LIST-SOURCES=util-dict-list.scm testing.import.scm \
util-tag.import.scm util-proc.import.scm util-tag.import.scm util-proc.import.scm \
util-set-list.import.scm
util-dict-list.o: util-dict-list.import.scm util-dict-list.o: util-dict-list.import.scm
util-dict-list.import.scm: $(UTIL-DICT-LIST-SOURCES) util-dict-list.import.scm: $(UTIL-DICT-LIST-SOURCES)

View file

@ -354,10 +354,11 @@
member-record member-record
(test-equal? make-member-record (test-equal? make-member-record
(make-member-record '|1234| "members/1234" '(|member|)) (make-member-record '|1234| "members/1234" '(|member|))
(make-ldict
'((file-name . |1234|) '((file-name . |1234|)
(file-path . "members/1234") (file-path . "members/1234")
(symlinks |member|) (symlinks |member|)
(id . 1234))) (id . 1234))))
(test-equal? make-member-record (test-equal? make-member-record
(make-member-record '|1234| "members/1234" '(|member|) #:msg "msg") (make-member-record '|1234| "members/1234" '(|member|) #:msg "msg")
'((msg . "msg") '((msg . "msg")

View file

@ -161,14 +161,15 @@
(test-equal? files+symlinks->files-dictionary (test-equal? files+symlinks->files-dictionary
(files+symlinks->files-dictionary (files+symlinks->files-dictionary
'(joe (2803 . joe))) '(joe (2803 . joe)))
'((joe 2803))) (make-ldict '((joe 2803))))
(test-equal? files+symlinks->files-dictionary (test-equal? files+symlinks->files-dictionary
(files+symlinks->files-dictionary (files+symlinks->files-dictionary
'(joe '(joe
(2803 . joe) (2803 . joe)
(666 . nonexistent))) (666 . nonexistent)))
'((nonexistent error-0 666) (make-ldict
(joe 2803))) '((joe 2803)
(nonexistent error-0 666))))
(test-true is-4digit-string? (is-4digit-string? "0000")) (test-true is-4digit-string? (is-4digit-string? "0000"))
(test-false is-4digit-string? (is-4digit-string? "AAAA")) (test-false is-4digit-string? (is-4digit-string? "AAAA"))
(test-false is-4digit-string? (is-4digit-string? "666")) (test-false is-4digit-string? (is-4digit-string? "666"))

View file

@ -48,6 +48,8 @@
ldict-filter ldict-filter
ldict-reduce ldict-reduce
ldict-equal?
ldict-tests! ldict-tests!
) )
@ -55,7 +57,8 @@
(chicken base) (chicken base)
testing testing
util-tag util-tag
util-proc) util-proc
util-set-list)
;; Tag used for identifying list dictionaries from this module ;; Tag used for identifying list dictionaries from this module
(define TAG-LDICT (make-tag LDICT)) (define TAG-LDICT (make-tag LDICT))
@ -208,6 +211,14 @@
(loop (cdr pairs) (loop (cdr pairs)
(proc acc (caar pairs) (cdar pairs)))))) (proc acc (caar pairs) (cdar pairs))))))
;; Returns true if both dictionaries contain the same keys and
;; values.
(define (ldict-equal? d1 d2)
(let ((k1 (list->lset (ldict-keys d1)))
(k2 (list->lset (ldict-keys d2))))
;; Compare key sets
#f))
;; Performs self-tests of the dictionary module. ;; Performs self-tests of the dictionary module.
(define (ldict-tests!) (define (ldict-tests!)
(run-tests (run-tests

View file

@ -50,6 +50,8 @@
lset-intersect lset-intersect
lset-subtract lset-subtract
lset=?
lset-tests! lset-tests!
) )
@ -172,6 +174,11 @@
(loop (cdr lst) (loop (cdr lst)
(lset-remove ls (car lst)))))) (lset-remove ls (car lst))))))
;; Returns true if two sets are equal
(define (lset=? s1 s2)
(and (lset-empty? (lset-subtract s1 s2))
(lset-empty? (lset-subtract s2 s1))))
;; Module self-tests ;; Module self-tests
(define (lset-tests!) (define (lset-tests!)
(run-tests (run-tests

View file

@ -30,6 +30,7 @@
( (
string-repeat string-repeat
string-first+rest string-first+rest
string-utf8?
) )
(import scheme (import scheme
@ -58,6 +59,12 @@
(cons key-str val)) (cons key-str val))
(cons str "")))) (cons str ""))))
;; Returns true, if given string contains UTF-8 characters
(define (string-utf8? str)
(let ((asciilen (string-length str))
(utf8len (length (irregex-extract (irregex "." 'u)))))
(not (= asciilen utf8len))))
;; Performs utils module self-tests. ;; Performs utils module self-tests.
(define (utils-tests!) (define (utils-tests!)
(run-tests (run-tests
@ -77,6 +84,8 @@
(test-equal? string-first+rest (test-equal? string-first+rest
(string-first+rest "asdf") (string-first+rest "asdf")
'("asdf" . "")) '("asdf" . ""))
(test-true string-utf8? (string-utf8? "ěščř"))
(test-false string-utf8? (string-utf8? "Hello World!"))
)) ))
) )