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

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)
-   (and (month<? m (cdr p))
+   (let ((m (if (null? ml)
-	(not (month<? m (car p)))))
+		(*current-month*)
+		(car ml))))
+     (and (month<? m (cdr p))
+	  (not (month<? m (car p))))))
 
  ;; Returns true if given month is in at least one of the periods
- ;; given.
+ ;; given. Defaults to current month.
- (define (month-in-periods? ps m)
+ (define (month-in-periods? ps . ml)
-   (let loop ((ps ps))
+   (let ((m (if (null? ml)
-     (if (null? ps)
+		(*current-month*)
-	 #f
+		(car ml))))
-	 (if (month-in-period? (car ps) m)
+     (let loop ((ps ps))
-	     #t
+       (if (null? ps)
-	     (loop (cdr ps))))))
+	   #f
+	   (if (month-in-period? (car ps) m)
+	       #t
+	       (loop (cdr ps)))))))
 
  ;; Returns string representing a month period with possibly open end.
  (define (period->string p)