diff --git a/member-record.scm b/member-record.scm index db01af3..71124f4 100644 --- a/member-record.scm +++ b/member-record.scm @@ -86,12 +86,24 @@ (monthmonth destroyed) (*current-month*))))) + ;; Returns true if the member is now suspended + (define (member-suspended? mr) + (let ((suspended (mr-ref mr 'suspended #f))) + (and suspended + (month-in-periods? suspended)))) + ;; Performs module self-tests. (define (member-record-tests!) (run-tests member-record - (test-true member-destroyed? - (member-destroyed? '((info . ((destroyed . "2010-05")))))) + (parameterize ((*current-month* (list 2023 2))) + (test-true member-destroyed? + (member-destroyed? '((info . ((destroyed . "2010-05"))))))) + (parameterize ((*current-month* (list 2009 2))) + (test-false member-destroyed? + (member-destroyed? '((info . ((destroyed . "2010-05"))))))) + (test-false member-destroyed? + (member-destroyed? '((info . ())))) )) ) diff --git a/period.scm b/period.scm index 37ff18d..4599d47 100644 --- a/period.scm +++ b/period.scm @@ -99,19 +99,25 @@ ;; True if month belongs to given month period - start inclusive, end ;; exclusive. - (define (month-in-period? p m) - (and (monthstring p)