diff --git a/Makefile b/Makefile index da4a787..013200e 100644 --- a/Makefile +++ b/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 diff --git a/brmsaptool.scm b/brmsaptool.scm index 748e277..13009a1 100644 --- a/brmsaptool.scm +++ b/brmsaptool.scm @@ -51,6 +51,7 @@ (command-line-tests!) (members-base-tests!) (primes-tests!) +(member-record-tests!) (newline) ;; Command-line options and configurable parameters diff --git a/member-record.scm b/member-record.scm index 53ed452..db01af3 100644 --- a/member-record.scm +++ b/member-record.scm @@ -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 + (monthmonth 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")))))) + )) + ) diff --git a/period.scm b/period.scm index c2f6e91..37ff18d 100644 --- a/period.scm +++ b/period.scm @@ -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