Fix dictionary tests and some bugs.

This commit is contained in:
Dominik Pantůček 2023-04-09 20:24:10 +02:00
parent a9921675ba
commit 42466416cd

View file

@ -126,13 +126,15 @@
(loop (cdr pairs)
(if (equality? (caar pairs) k)
res
(cons (car pairs) res)))))))
(cons (car pairs) res))
(and failure
(not (equality? (caar pairs) k))))))))
;; Adds a new value v under the key k to the dictionary d possibly
;; overwriting any value which has been stored under the key
;; before. Returns the updated dictionary.
(define (ldict-set ld k v)
(let ((equality? (ldict-equalit? ld)))
(let ((equality? (ldict-equality? ld)))
(let loop ((pairs (ldict-pairs ld))
(res '()))
(if (null? pairs)
@ -156,7 +158,7 @@
(let* ((lpi (length (procedure-information proc)))
(both? (> lpi 2))
(index? (> lpi 3)))
(let loop ((pairs (ldict-pairs))
(let loop ((pairs (ldict-pairs ld))
(res '())
(i 0))
(if (null? pairs)
@ -171,7 +173,7 @@
(proc k v i)
(proc k v))
(proc v)))
r))
res))
(add1 i))))))
;; Returns a dictionary containing only kv pairs matching the
@ -203,31 +205,39 @@
(define (ldict-tests!)
(run-tests
dict
(test-true make-dict (null? (make-dict)))
(test-exn dict-ref (dict-ref (make-dict) 'nonexistent))
(test-true dict-ref (dict-ref (make-dict) 'nonexistent #t))
(test-equal? dict-set (dict-set (make-dict) 'nonexistent 1) '((nonexistent . 1)))
(test-equal? dict-set (dict-set (dict-set (make-dict) 'existent 1) 'existent 2) '((existent . 2)))
(test-exn dict-remove (dict-remove (make-dict) 'nonexistent))
(test-true dict-remove (null? (dict-remove (dict-set (make-dict) 'existing 1) 'existing)))
(test-equal? dict-keys (dict-keys (dict-set (make-dict) 'existing 1)) '(existing))
(test-equal? dict-map (dict-map (lambda (v) (* 2 v))
'((a . 1)
(b . 2)))
'((b . 4)
(a . 2)))
(test-equal? dict-map (dict-map (lambda (k v) (* 2 v))
'((a . 1)
(b . 2)))
'((b . 4)
(a . 2)))
(test-equal? dict-filter (dict-filter (lambda (k v)
(odd? v))
'((a . 1)
(b . 2)))
'((a . 1)))
(test-eq? dict-reduce
(dict-reduce 0 (lambda (a k v) (+ a v)) '((a . 1) (b . 2)))
(test-equal? make-ldict (make-ldict) `(,TAG-LDICT (,eq?)))
(test-exn ldict-ref (ldict-ref (make-ldict) 'nonexistent))
(test-true ldict-ref (ldict-ref (make-ldict) 'nonexistent #t))
(test-equal? ldict-set (ldict-set (make-ldict) 'nonexistent 1)
`(,TAG-LDICT (,eq?) (nonexistent . 1)))
(test-equal? ldict-set (ldict-set (ldict-set (make-ldict) 'existent 1) 'existent 2)
`(,TAG-LDICT (,eq?) (existent . 2)))
(test-exn ldict-remove (ldict-remove (make-ldict) 'nonexistent))
(test-equal? ldict-remove
(ldict-remove (ldict-set (make-ldict) 'existing 1) 'existing)
(make-ldict))
(test-equal? ldict-keys (ldict-keys (ldict-set (make-ldict) 'existing 1)) '(existing))
(test-equal? ldict-map
(ldict-map (lambda (v) (* 2 v))
(make-ldict '((a . 1)
(b . 2))))
(make-ldict '((b . 4)
(a . 2))))
(test-equal? ldict-map
(ldict-map (lambda (k v) (* 2 v))
(make-ldict '((a . 1)
(b . 2))))
(make-ldict '((b . 4)
(a . 2))))
(test-equal? ldict-filter
(ldict-filter (lambda (k v)
(odd? v))
(make-ldict '((a . 1)
(b . 2))))
(make-ldict '((a . 1))))
(test-eq? ldict-reduce
(ldict-reduce 0 (lambda (a k v) (+ a v))
(make-ldict '((a . 1) (b . 2))))
3)
))