brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Fix dictionary tests and some bugs.

Browse source
This commit is contained in:
Dominik Pantůček 2023-04-09 20:24:10 +02:00
parent a9921675ba
commit 42466416cd
1 changed files with 39 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

66
src/util-dict.scm
View file

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