Start testing member-record, fix current month inference.

This commit is contained in:
Dominik Pantůček 2023-03-18 15:54:25 +01:00
parent 023befa8f8
commit 798cfe318c
4 changed files with 35 additions and 4 deletions

View file

@ -141,7 +141,8 @@ primes.so: $(PRIMES-SOURCES)
primes.o: primes.import.scm
primes.import.scm: primes.so
MEMBER-RECORD-SOURCES=member-record.scm
MEMBER-RECORD-SOURCES=member-record.scm dictionary.import.scm \
period.import.scm testing.import.scm month.import.scm
member-record.so: $(MEMBER-RECORD-SOURCES)
member-record.o: member-record.import.scm

View file

@ -51,6 +51,7 @@
(command-line-tests!)
(members-base-tests!)
(primes-tests!)
(member-record-tests!)
(newline)
;; Command-line options and configurable parameters

View file

@ -30,6 +30,7 @@
member-record
(
print-member-record-info
member-record-tests!
)
(import scheme
@ -38,8 +39,10 @@
(chicken sort)
dictionary
period
)
testing
month)
;; Prints human-readable information
(define (print-member-record-info mr)
(let* ((id (dict-ref mr 'id))
(aliases (dict-ref mr 'symlinks))
@ -65,4 +68,30 @@
v))
(loop (cdr sinfo)))))))
;; Returns key from the top-level (members-base) record if it exists,
;; queries the 'info key otherwise. Optional default argument works
;; like with dict-ref.
(define (mr-ref mr key . dfl)
(if (dict-has-key? mr key)
(dict-ref mr key)
(if (null? dfl)
(dict-ref (dict-ref mr 'info) key)
(dict-ref (dict-ref mr 'info) key (car dfl)))))
;; Returns true if the member record represents destroyed member. The
;; *current-month* is a global parameter from period module.
(define (member-destroyed? mr)
(let ((destroyed (mr-ref mr 'destroyed #f)))
(and destroyed
(month<? (string->month destroyed)
(*current-month*)))))
;; Performs module self-tests.
(define (member-record-tests!)
(run-tests
member-record
(test-true member-destroyed?
(member-destroyed? '((info . ((destroyed . "2010-05"))))))
))
)

View file

@ -53,7 +53,7 @@
(define *current-month*
(make-parameter
(let ((d (seconds->local-time (current-seconds))))
(list (vector-ref d 5)
(list (+ 1900 (vector-ref d 5))
(vector-ref d 4)))))
;; Sorts period markers (be it start or end) chronologically and