Work on day in period.

src/brmember.scm

@@ -473,9 +473,9 @@
 		   (make-ldict `((info . ,(make-ldict
 					   `((member . (,(make-cal-period
 							  (make-cal-month 2015 1) #f)))
-					     (suspend (make-cal-period
+					     (suspend ,(make-cal-period
 							(make-cal-month 2010 1)
-						       (make-cal-onth 2022 4)
+							(make-cal-month 2022 4)
 							#f #f))))))))))
     (test-true brmember-active?
 	       (parameterize ((*current-month* (make-cal-month 2023 2)))
@@ -484,7 +484,7 @@
 					  `((member . (,(make-cal-period
 							 (make-cal-month 2015 1)
 							 #f)))
-					    (suspend (make-cal-period
+					    (suspend ,(make-cal-period
 						       (make-cal-month 2010 1)
 						       (make-cal-month 2022 4)
 						       #f #f))))))))))

src/cal-period.scm

@@ -52,6 +52,7 @@
   lookup-by-cal-period
 
   cal-ensure-month
+  cal-ensure-day
   
   cal-period-tests!
   )
@@ -215,6 +216,17 @@
 	       #t
 	       (loop (cdr ps)))))))
 
+ ;; Checks whether given day belongs to day or month period
+ (define (cal-day-in-period? p . dl)
+   (let ((d (if (null? dl)
+		(*current-day*)
+		(cal-ensure-day (car dl))))
+	 (before (cal-ensure-day (cal-period-before p)))
+	 (since (cal-ensure-day (cal-period-since p))))
+     (and (or (not before)
+	      (cal-day<? d before))
+	  (not (cal-day<? d since)))))
+
  ;; Returns string representing a month period with possibly open end.
  (define (cal-period->string p)
    (sprintf "~A..~A"
@@ -271,7 +283,21 @@
    (if v
        (if (cal-month? v)
 	   v
-	   (apply cal-day->month v stop?s))
+	   (if (cal-day? v)
+	       (apply cal-day->month v stop?s)
+	       #f))
+       #f))
+
+ ;; Ensures day for checking the periods
+ (define (cal-ensure-day v)
+   (if v
+       (if (cal-day? v)
+	   v
+	   (if (cal-month? v)
+	       (make-cal-day (cal-month-year v)
+			     (cal-month-month v)
+			     1)
+	       #f))
        #f))
 
  ;; Performs self-tests of the period module.

src/testing.scm

@@ -91,7 +91,7 @@
       (let ((result expression))
 	(if (eq? result #f)
 	    (display ".")
-	    (error 'test-true (sprintf "~A expression=~S result=~S"
+	    (error 'test-false (sprintf "~A expression=~S result=~S"
 				       'name 'expression result)))))))
 
  ;; Passes if the-test raises an exception