;*=====================================================================*/
;*    serrano/prgm/project/bigloo/recette/date.scm                     */
;*    -------------------------------------------------------------    */
;*    Author      :  Manuel Serrano                                    */
;*    Creation    :  Wed Feb  5 10:03:10 2003                          */
;*    Last change :  Wed Sep 17 10:11:27 2003 (serrano)                */
;*    Copyright   :  2003 Manuel Serrano                               */
;*    -------------------------------------------------------------    */
;*    Test date features                                               */
;*=====================================================================*/

;*---------------------------------------------------------------------*/
;*    The module                                                       */
;*---------------------------------------------------------------------*/
(module date
   (import  (main "main.scm"))
   (include "test.sch")
   (export  (test-date)))

;*---------------------------------------------------------------------*/
;*    test-date ...                                                    */
;*---------------------------------------------------------------------*/
(define (test-date)
   (test-module "date" "date.scm")
   (test "date?" (date? (pwd)) #f)
   (test "date?" (date? (current-date)) #t)
   (test "seconds->date.1" (date? (seconds->date (current-seconds))) #t)
   (let* ((s1 (current-seconds))
	  (d1 (seconds->date s1)))
      (test "seconds->date.2" (date->seconds d1) s1))
   (let* ((d1 (current-date))
	  (s1 (date->seconds d1)))
      (test "seconds->date.3" (seconds->date s1) d1))
   (test "date-day.1" (date-day (make-date 1 1 1 19 2 2000 0 0)) 19)
   (test "date-day.2" (date-day (make-date 1 1 1 31 5 1999 0 0)) 31)
   (test "date-day.3" (date-day
		       (seconds->date
			(date->seconds (make-date 1 1 1 30 5 1998 0 0))))
	 30)
   (test "date-day.4" (date-day
		       (seconds->date
			(date->seconds (make-date 1 1 1 31 5 1971 0 0))))
	 31)
   (test "date-wday.1" (date-wday (make-date 1 1 1 2 2 2003 0 0)) 1)
   (test "date-wday.2" (date-wday (make-date 1 1 1 3 2 2003 0 0)) 2)
   (test "date-wday.3" (date-wday (make-date 1 1 1 4 2 2003 0 0)) 3)
   (test "date-wday.4" (date-wday (make-date 1 1 1 5 2 2003 0 0)) 4)
   (test "date-wday.5" (date-wday (make-date 1 1 1 6 2 2003 0 0)) 5)
   (test "date-wday.6" (date-wday (make-date 1 1 1 7 2 2003 0 0)) 6)
   (test "date-wday.7" (date-wday (make-date 1 1 1 8 2 2003 0 0)) 7)
   (test "date-month" (date-month (make-date 1 1 1 17 5 1980 0 0)) 5)
   (test "date-year" (date-year (make-date 1 1 1 17 5 1981 0 0)) 1981)
   (test "leap-year?" (leap-year? 1966) #f)
   (test "leap-year?" (leap-year? 1968) #t)
   (test "leap-year?" (leap-year? 2000) #t)
   (test "leap-year?" (leap-year? 2100) #f)
   (test "dst.1" (date-hour (make-date 0 0 14 6 1 2003)) 14)
   (test "dst.2" (date-hour (make-date 0 0 14 6 7 2003)) 14)
   (test "dst.3" (date-hour (make-date 0 0 14 6 7 2003)) 14)
   (test "dst.4" (date-hour (make-date 0 0 23 6 7 2003)) 23)
   (test "dst.5" (date-day (make-date 0 30 23 6 7 2003)) 6)
   (let ((d1 (date->seconds (make-date 0 30 23 6 7 2003))))
      (test "dst.6" (date->seconds (seconds->date d1)) d1))
   (let ((d1 (date->seconds (make-date 0 30 23 6 1 2003))))
      (test "dst.7" (date->seconds (seconds->date d1)) d1))
   (test "seconds-add" (date-day
			(seconds->date
			 (+second
			  (date->seconds (make-date 1 1 1 16 5 1996 0 0))
			  (day-seconds))))
	 17)
   (test "seconds-add" (date-month
			(seconds->date
			 (+second
			  (date->seconds (make-date 1 1 1 31 5 1996 0 0))
			  (day-seconds))))
	 6)
   (test "seconds-add" (date-day
			(seconds->date
			 (+second
			  (date->seconds (make-date 1 1 1 31 5 1996 0 0))
			  (day-seconds))))
	 1)
   (test "seconds-add" (date-day
			(seconds->date
			 (+second
			  (date->seconds (make-date 1 1 1 17 5 1996 0 0))
			  (*second #e31 (day-seconds)))))
	 17)
   (test "seconds-add" (date-month
			(seconds->date
			 (+second
			  (date->seconds (make-date 1 1 1 17 5 1996 0 0))
			  (*second #e31 (day-seconds)))))
	 6)
   (test "seconds-add" (date-day
			(seconds->date
			 (+second
			  (date->seconds (make-date 1 1 1 31 5 1996 0 0))
			  #e0)))
	 31)
   (test "seconds-sub" (date-day
			(seconds->date
			 (-second
			  (date->seconds (make-date 1 1 1 18 5 1996 0 0))
			  (day-seconds))))
	 17)
   (test "=second" (=second (date->seconds (make-date 1 1 1 20 6 1996))
			    (date->seconds (make-date 1 1 1 20 6 1996)))
	 #t)
   (test "=second" (=second (date->seconds (make-date 1 1 1 20 6 1996))
			    (date->seconds (make-date 1 1 1 19 6 1996)))
	 #f)
   (test "<second" (<second (date->seconds (make-date 1 1 1 18 6 1996))
			    (date->seconds (make-date 1 1 1 19 6 1996)))
	 #t)
   (test "<second" (<second (date->seconds (make-date 1 1 1 20 6 1996))
			    (date->seconds (make-date 1 1 1 19 6 1996)))
	 #f)
   (test "<=second" (<=second (date->seconds (make-date 1 1 1 18 6 1996))
			      (date->seconds (make-date 1 1 1 19 6 1996)))
	 #t)
   (test "<=second" (<=second (date->seconds (make-date 1 1 1 18 6 1996))
			      (date->seconds (make-date 1 1 1 18 6 1996)))
	 #t)
   (test "<=second" (<second (date->seconds (make-date 1 1 1 20 6 1996))
			     (date->seconds (make-date 1 1 1 19 6 1996)))
	 #f)
   (test ">second" (>second (date->seconds (make-date 1 1 1 18 6 1996))
			    (date->seconds (make-date 1 1 1 19 6 1996)))
	 #f)
   (test ">second" (>second (date->seconds (make-date 1 1 1 20 6 1996))
			    (date->seconds (make-date 1 1 1 19 6 1996)))
	 #t)
   (test ">=second.1" (>=second (date->seconds (make-date 1 1 1 18 6 1996))
				(date->seconds (make-date 1 1 1 19 6 1996)))
	 #f)
   (test ">=second.2" (>=second (date->seconds (make-date 1 1 1 18 6 1996))
				(date->seconds (make-date 1 1 1 18 6 1996)))
	 #t)
   (test ">=second.3" (>second (date->seconds (make-date 1 1 1 20 6 1996))
			       (date->seconds (make-date 1 1 1 19 6 1996)))
	 #t)
   (test "date->utc-string" (string? (date->utc-string (current-date))) #t))
