Start testing member-record, fix current month inference.
This commit is contained in:
parent
023befa8f8
commit
798cfe318c
4 changed files with 35 additions and 4 deletions
3
Makefile
3
Makefile
|
@ -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
|
||||
|
|
|
@ -51,6 +51,7 @@
|
|||
(command-line-tests!)
|
||||
(members-base-tests!)
|
||||
(primes-tests!)
|
||||
(member-record-tests!)
|
||||
(newline)
|
||||
|
||||
;; Command-line options and configurable parameters
|
||||
|
|
|
@ -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"))))))
|
||||
))
|
||||
|
||||
)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue