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

Fix member record tests.

Browse source
This commit is contained in:
Dominik Pantůček 2023-04-11 13:58:59 +02:00
parent 575c1cdb3d
commit cf2913fdea
2 changed files with 66 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

73
src/member-record.scm
View file

@ -352,50 +352,71 @@
(define (member-record-tests!)
(run-tests
member-record
(test-equal? make-member-record
(make-member-record '|1234| "members/1234" '(|member|))
(make-ldict
'((file-name . |1234|)
(test-true make-member-record
(ldict-equal?
(make-member-record '|1234| "members/1234" '(|member|))
(make-ldict
'((file-name . |1234|)
(file-path . "members/1234")
(symlinks |member|)
(id . 1234))))
(test-equal? make-member-record
(make-member-record '|1234| "members/1234" '(|member|) #:msg "msg")
(id . 1234)))))
(test-true make-member-record
(ldict-equal?
(make-member-record '|1234| "members/1234" '(|member|) #:msg "msg")
(make-ldict
'((msg . "msg")
(file-name . |1234|)
(file-path . "members/1234")
(symlinks |member|)
(id . 1234)))
(test-equal? member-record-set
(member-record-set '() #:id 1234)
'((id . 1234)))
(test-equal? member-record-add-highlight
(member-record-add-highlight '() 123 "Interesting..." 0 'info)
'((highlights . ((123 "Interesting..." 0 info)))))
(id . 1234)))))
(test-true member-record-set
(ldict-equal?
(member-record-set (make-ldict) #:id 1234)
(make-ldict
'((id . 1234)))))
(test-true member-record-add-highlight
(ldict-equal?
(member-record-add-highlight (make-ldict) 123 "Interesting..." 0 'info)
(make-ldict
'((highlights . ((123 "Interesting..." 0 info)))))))
(test-true member-destroyed?
(parameterize ((*current-month* (list 2023 2)))
(member-destroyed? '((info . ((member . (((2010 1) (2010 5))))))))))
(member-destroyed?
(make-ldict `((info . ,(make-ldict
`((member . (((2010 1) (2010 5))))))))))))
(test-false member-destroyed?
(parameterize ((*current-month* (list 2009 2)))
(member-destroyed? '((info . ((member . (((2001 1) (2010 5))))))))))
(member-destroyed?
(make-ldict `((info . ,(make-ldict
`((member . (((2001 1) (2010 5))))))))))))
(test-false member-suspended?
(member-suspended? '((info . ((member . (((2015 1) #f))))))))
(member-suspended?
(make-ldict `((info . ,(make-ldict
`((member . (((2015 1) #f))))))))))
(test-true member-suspended?
(parameterize ((*current-month* (list 2015 2)))
(member-suspended? '((info . ((member . (((2015 1) #f)))
(suspend ((2010 1) (2022 4) #f #f))))))))
(member-suspended?
(make-ldict `((info . ,(make-ldict
`((member . (((2015 1) #f)))
(suspend ((2010 1) (2022 4) #f #f))))))))))
(test-true member-suspended?
(parameterize ((*current-month* (list 2015 2)))
(member-suspended? '((info . ((member . (((2015 1) #f)))
(suspend ((2010 1) #f #f #f))))))))
(member-suspended?
(make-ldict `((info . ,(make-ldict
`((member . (((2015 1) #f)))
(suspend ((2010 1) #f #f #f))))))))))
(test-false member-suspended?
(parameterize ((*current-month* (list 2023 2)))
(member-suspended? '((info . ((member . (((2015 1) #f)))
(suspend ((2010 1) (2022 4) #f #f))))))))
(member-suspended?
(make-ldict `((info . ,(make-ldict
`((member . (((2015 1) #f)))
(suspend ((2010 1) (2022 4) #f #f))))))))))
(test-true member-active?
(parameterize ((*current-month* (list 2023 2)))
(member-active? '((info . ((member . (((2015 1) #f)))
(suspend ((2010 1) (2022 4) #f #f))))))))
(parameterize ((*current-month* (list 2023 2)))
(member-active?
(make-ldict `((info . ,(make-ldict
`((member . (((2015 1) #f)))
(suspend ((2010 1) (2022 4) #f #f))))))))))
))
)

24
src/util-dict-list.scm
View file

@ -213,11 +213,25 @@
;; 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))
(define (ldict-equal? d1 d2 . equality?)
(let ((e1 (ldict-equality? d1))
(e2 (ldict-equality? d2)))
(let ((equality? (if (null? equality?)
equal?
(car equality?))))
(if (not (eq? e1 e2))
#f
(let ((k1 (list->lset (ldict-keys d1)))
(k2 (list->lset (ldict-keys d2))))
(if (lset=? k1 k2)
(let loop ((keys (lset->list k1)))
(if (null? keys)
#t
(if (equality? (ldict-ref d1 (car keys))
(ldict-ref d2 (car keys)))
(loop (cdr keys))
#f)))
#f))))))
;; Performs self-tests of the dictionary module.
(define (ldict-tests!)