Improve period checking with current month.

member-record.scm

@@ -86,12 +86,24 @@
 	  (month<? (string->month 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
+    (parameterize ((*current-month* (list 2023 2)))
       (test-true member-destroyed?
-	       (member-destroyed? '((info . ((destroyed . "2010-05"))))))
+		 (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 . ()))))
     ))
 
  )

period.scm

@@ -99,19 +99,25 @@
 
  ;; True if month belongs to given month period - start inclusive, end
  ;; exclusive.
- (define (month-in-period? p m)
+ (define (month-in-period? p . ml)
+   (let ((m (if (null? ml)
+		(*current-month*)
+		(car ml))))
      (and (month<? m (cdr p))
-	(not (month<? m (car p)))))
+	  (not (month<? m (car p))))))
 
  ;; Returns true if given month is in at least one of the periods
- ;; given.
- (define (month-in-periods? ps m)
+ ;; given. Defaults to current month.
+ (define (month-in-periods? ps . ml)
+   (let ((m (if (null? ml)
+		(*current-month*)
+		(car ml))))
      (let loop ((ps ps))
        (if (null? ps)
 	   #f
 	   (if (month-in-period? (car ps) m)
 	       #t
-	     (loop (cdr ps))))))
+	       (loop (cdr ps)))))))
 
  ;; Returns string representing a month period with possibly open end.
  (define (period->string p)