#lang scheme/base
(require "test-base.ss")
(require (prefix-in srfi- srfi/19)
"date.ss")
(require/expose "date.ss"
(months->days))
(define (st str)
(and str (date->time-utc (string->date str "~Y-~m-~d ~H:~M"))))
(define (ts time)
(and time (date->string (time-utc->date time) "~Y-~m-~d ~H:~M")))
(define-syntax-rule (with-time-zones expr ...)
(for ([tz (in-list (list "GB" "PST8PDT"))])
(parameterize ([current-tz tz])
(with-check-info (['current-tz tz])
expr ...))))
(define-syntax-rule (with-time-zone tz expr ...)
(parameterize ([current-tz tz])
(with-check-info (['current-tz tz])
expr ...)))
(define/provide-test-suite date-tests
(test-case "make-date"
(parameterize ([current-tz "GB"])
(check-equal? (make-date 0 00 00 01 28 03 2010) (srfi-make-date 0 00 00 01 28 03 2010 0))
(check-equal? (make-date 0 00 00 02 28 03 2010) (srfi-make-date 0 00 00 02 28 03 2010 3600))
(check-equal? (make-date 0 00 00 01 31 10 2010) (srfi-make-date 0 00 00 01 31 10 2010 3600))
(check-equal? (make-date 0 00 00 02 31 10 2010) (srfi-make-date 0 00 00 02 31 10 2010 0))
(check-equal? (make-date 0 00 00 01 27 03 2011) (srfi-make-date 0 00 00 01 27 03 2011 0))
(check-equal? (make-date 0 00 00 02 27 03 2011) (srfi-make-date 0 00 00 02 27 03 2011 3600))
(check-equal? (make-date 0 00 00 01 30 10 2011) (srfi-make-date 0 00 00 01 30 10 2011 3600))
(check-equal? (make-date 0 00 00 02 30 10 2011) (srfi-make-date 0 00 00 02 30 10 2011 0)))
(parameterize ([current-tz "PST8PDT"])
(check-equal? (make-date 0 00 00 02 14 03 2010) (srfi-make-date 0 00 00 02 14 03 2010 -28800))
(check-equal? (make-date 0 00 00 03 14 03 2010) (srfi-make-date 0 00 00 03 14 03 2010 -25200))
(check-equal? (make-date 0 00 00 01 07 11 2010) (srfi-make-date 0 00 00 01 07 11 2010 -25200))
(check-equal? (make-date 0 00 00 02 07 11 2010) (srfi-make-date 0 00 00 02 07 11 2010 -28800))
(check-equal? (make-date 0 00 00 02 13 03 2011) (srfi-make-date 0 00 00 02 13 03 2011 -28800))
(check-equal? (make-date 0 00 00 03 13 03 2011) (srfi-make-date 0 00 00 03 13 03 2011 -25200))
(check-equal? (make-date 0 00 00 01 06 11 2011) (srfi-make-date 0 00 00 01 06 11 2011 -25200))
(check-equal? (make-date 0 00 00 02 06 11 2011) (srfi-make-date 0 00 00 02 06 11 2011 -28800))))
(test-case "date->string"
(check-equal? (date->string (make-date 0 00 00 00 28 03 2010) "~Y-~m-~d ~H:~M") "2010-03-28 00:00")
(check-equal? (date->string (make-date 0 00 00 01 28 03 2010) "~Y-~m-~d ~H:~M") "2010-03-28 02:00")
(check-equal? (date->string (make-date 0 00 00 02 28 03 2010) "~Y-~m-~d ~H:~M") "2010-03-28 02:00")
(check-equal? (date->string (srfi-make-date 0 00 00 09 01 01 2010 3600) "~Y-~m-~d ~H:~M") "2010-01-01 08:00")
(check-equal? (date->string (srfi-make-date 0 00 00 09 01 07 2010 0) "~Y-~m-~d ~H:~M") "2010-07-01 10:00"))
(test-case "string->date"
(parameterize ([current-tz "GB"])
(check-equal? (string->date "2010-03-28 01:00" "~Y-~m-~d ~H:~M") (srfi-make-date 0 00 00 01 28 03 2010 0))
(check-equal? (string->date "2010-03-28 02:00" "~Y-~m-~d ~H:~M") (srfi-make-date 0 00 00 02 28 03 2010 3600))
(check-equal? (string->date "2010-10-31 01:00" "~Y-~m-~d ~H:~M") (srfi-make-date 0 00 00 01 31 10 2010 3600))
(check-equal? (string->date "2010-10-31 02:00" "~Y-~m-~d ~H:~M") (srfi-make-date 0 00 00 02 31 10 2010 0))
(check-equal? (string->date "2011-03-27 01:00" "~Y-~m-~d ~H:~M") (srfi-make-date 0 00 00 01 27 03 2011 0))
(check-equal? (string->date "2011-03-27 02:00" "~Y-~m-~d ~H:~M") (srfi-make-date 0 00 00 02 27 03 2011 3600))
(check-equal? (string->date "2011-10-30 01:00" "~Y-~m-~d ~H:~M") (srfi-make-date 0 00 00 01 30 10 2011 3600))
(check-equal? (string->date "2011-10-30 02:00" "~Y-~m-~d ~H:~M") (srfi-make-date 0 00 00 02 30 10 2011 0)))
(parameterize ([current-tz "PST8PDT"])
(check-equal? (string->date "2010-03-14 02:00" "~Y-~m-~d ~H:~M") (srfi-make-date 0 00 00 02 14 03 2010 -28800))
(check-equal? (string->date "2010-03-14 03:00" "~Y-~m-~d ~H:~M") (srfi-make-date 0 00 00 03 14 03 2010 -25200))
(check-equal? (string->date "2010-11-07 01:00" "~Y-~m-~d ~H:~M") (srfi-make-date 0 00 00 01 07 11 2010 -25200))
(check-equal? (string->date "2010-11-07 02:00" "~Y-~m-~d ~H:~M") (srfi-make-date 0 00 00 02 07 11 2010 -28800))
(check-equal? (string->date "2011-03-13 02:00" "~Y-~m-~d ~H:~M") (srfi-make-date 0 00 00 02 13 03 2011 -28800))
(check-equal? (string->date "2011-03-13 03:00" "~Y-~m-~d ~H:~M") (srfi-make-date 0 00 00 03 13 03 2011 -25200))
(check-equal? (string->date "2011-11-06 01:00" "~Y-~m-~d ~H:~M") (srfi-make-date 0 00 00 01 06 11 2011 -25200))
(check-equal? (string->date "2011-11-06 02:00" "~Y-~m-~d ~H:~M") (srfi-make-date 0 00 00 02 06 11 2011 -28800))))
(test-case "time-utc->date, time-tai->date"
(for ([convert (in-list (list (compose time-utc->date date->time-utc)
(compose time-tai->date date->time-tai)))]
[time-type (in-list (list time-utc time-tai))])
(with-check-info (['time-type time-type])
(parameterize ([current-tz "GB"])
(check-equal? (convert (srfi-make-date 0 00 00 00 28 03 2010 0)) (srfi-make-date 0 00 00 00 28 03 2010 0))
(check-equal? (convert (srfi-make-date 0 00 00 01 28 03 2010 0)) (srfi-make-date 0 00 00 02 28 03 2010 3600))
(check-equal? (convert (srfi-make-date 0 00 00 02 28 03 2010 0)) (srfi-make-date 0 00 00 03 28 03 2010 3600))
(check-equal? (convert (srfi-make-date 0 00 00 00 28 03 2010 3600)) (srfi-make-date 0 00 00 23 27 03 2010 0))
(check-equal? (convert (srfi-make-date 0 00 00 01 28 03 2010 3600)) (srfi-make-date 0 00 00 00 28 03 2010 0))
(check-equal? (convert (srfi-make-date 0 00 00 02 28 03 2010 3600)) (srfi-make-date 0 00 00 02 28 03 2010 3600))
(check-equal? (convert (srfi-make-date 0 00 00 01 28 03 2010 3600)) (srfi-make-date 0 00 00 00 28 03 2010 0))
(check-equal? (convert (srfi-make-date 0 00 00 02 28 03 2010 0)) (srfi-make-date 0 00 00 03 28 03 2010 3600)))
(parameterize ([current-tz "PST8PDT"])
(check-equal? (convert (srfi-make-date 0 00 00 01 14 03 2010 -28800)) (srfi-make-date 0 00 00 01 14 03 2010 -28800))
(check-equal? (convert (srfi-make-date 0 00 00 02 14 03 2010 -28800)) (srfi-make-date 0 00 00 03 14 03 2010 -25200))
(check-equal? (convert (srfi-make-date 0 00 00 03 14 03 2010 -28800)) (srfi-make-date 0 00 00 04 14 03 2010 -25200))
(check-equal? (convert (srfi-make-date 0 00 00 01 14 03 2010 -25200)) (srfi-make-date 0 00 00 00 14 03 2010 -28800))
(check-equal? (convert (srfi-make-date 0 00 00 02 14 03 2010 -25200)) (srfi-make-date 0 00 00 01 14 03 2010 -28800))
(check-equal? (convert (srfi-make-date 0 00 00 03 14 03 2010 -25200)) (srfi-make-date 0 00 00 03 14 03 2010 -25200))
(check-equal? (convert (srfi-make-date 0 00 00 02 14 03 2010 -25200)) (srfi-make-date 0 00 00 01 14 03 2010 -28800))
(check-equal? (convert (srfi-make-date 0 00 00 03 14 03 2010 -28800)) (srfi-make-date 0 00 00 04 14 03 2010 -25200))))))
(test-case "months->days"
(check-equal? (months->days 0 2010 1) 0)
(check-equal? (months->days 1 2010 1) 31)
(check-equal? (months->days 2 2010 1) 59)
(check-equal? (months->days 12 2010 1) 365)
(check-equal? (months->days 3 2010 11) 92)
(check-equal? (months->days 1 2012 1) 31)
(check-equal? (months->days 2 2012 1) 60)
(check-equal? (months->days 12 2012 1) 366)
(check-equal? (months->days 12 2012 3) 365)
(check-equal? (months->days -1 2010 1) -31)
(check-equal? (months->days -2 2010 1) -61)
(check-equal? (months->days -12 2010 1) -365)
(check-equal? (months->days -3 2010 11) -92)
(check-equal? (months->days -2 2012 2) -62)
(check-equal? (months->days -2 2012 3) -60)
(check-equal? (months->days -12 2012 3) -366)
(check-equal? (months->days -12 2012 2) -365))
(test-case "date+seconds"
(check-equal? (date+seconds (srfi-make-date 0 00 00 09 01 01 2010 0) 1) (srfi-make-date 0 01 00 09 01 01 2010 0))
(check-equal? (date+seconds (srfi-make-date 0 00 00 09 01 01 2010 0) 61) (srfi-make-date 0 01 01 09 01 01 2010 0))
(check-equal? (date+seconds (srfi-make-date 0 00 00 09 01 01 2010 0) 3601) (srfi-make-date 0 01 00 10 01 01 2010 0))
(check-equal? (date+seconds (srfi-make-date 0 00 00 09 01 01 2010 0) 86401) (srfi-make-date 0 01 00 09 02 01 2010 0))
(check-equal? (date+seconds (srfi-make-date 0 00 00 09 27 03 2010 0) 86400) (srfi-make-date 0 00 00 10 28 03 2010 3600)))
(test-case "date+minutes"
(check-equal? (date+minutes (srfi-make-date 0 00 00 09 01 01 2010 0) 1) (srfi-make-date 0 00 01 09 01 01 2010 0))
(check-equal? (date+minutes (srfi-make-date 0 00 00 09 01 01 2010 0) 61) (srfi-make-date 0 00 01 10 01 01 2010 0))
(check-equal? (date+minutes (srfi-make-date 0 00 00 09 01 01 2010 0) 1441) (srfi-make-date 0 00 01 09 02 01 2010 0))
(check-equal? (date+minutes (srfi-make-date 0 00 00 09 27 03 2010 0) 1440) (srfi-make-date 0 00 00 10 28 03 2010 3600)))
(test-case "date+hours"
(check-equal? (date+hours (srfi-make-date 0 00 00 09 01 01 2010 0) 1) (srfi-make-date 0 00 00 10 01 01 2010 0))
(check-equal? (date+hours (srfi-make-date 0 00 00 09 01 01 2010 0) 25) (srfi-make-date 0 00 00 10 02 01 2010 0))
(check-equal? (date+hours (srfi-make-date 0 00 00 09 27 03 2010 0) 24) (srfi-make-date 0 00 00 10 28 03 2010 3600)))
(test-case "date+days"
(check-equal? (date+days (srfi-make-date 0 00 00 09 01 01 2010 0) 1) (srfi-make-date 0 00 00 09 02 01 2010 0))
(check-equal? (date+days (srfi-make-date 0 00 00 09 01 01 2010 0) 31) (srfi-make-date 0 00 00 09 01 02 2010 0))
(check-equal? (date+days (srfi-make-date 0 00 00 09 26 03 2010 0) 1) (srfi-make-date 0 00 00 09 27 03 2010 0))
(check-equal? (date+days (srfi-make-date 0 00 00 09 27 03 2010 0) 1) (srfi-make-date 0 00 00 09 28 03 2010 3600))
(check-equal? (date+days (srfi-make-date 0 00 00 09 27 03 2010 3600) 1) (srfi-make-date 0 00 00 08 28 03 2010 3600)))
(test-case "date+weeks"
(check-equal? (date+weeks (srfi-make-date 0 00 00 09 01 01 2010 0) 1) (srfi-make-date 0 00 00 09 08 01 2010 0))
(check-equal? (date+weeks (srfi-make-date 0 00 00 09 22 03 2010 0) 1) (srfi-make-date 0 00 00 09 29 03 2010 3600))
(check-equal? (date+weeks (srfi-make-date 0 00 00 09 22 03 2010 3600) 1) (srfi-make-date 0 00 00 08 29 03 2010 3600)))
(test-case "date+months"
(check-equal? (date+months (srfi-make-date 0 00 00 09 01 01 2010 0) 1) (srfi-make-date 0 00 00 09 01 02 2010 0))
(check-equal? (date+months (srfi-make-date 0 00 00 09 01 01 2010 0) 6) (srfi-make-date 0 00 00 09 01 07 2010 3600))
(check-equal? (date+months (srfi-make-date 0 00 00 09 01 01 2010 3600) 6) (srfi-make-date 0 00 00 08 01 07 2010 3600))
(check-equal? (date+months (srfi-make-date 0 00 00 09 01 01 2012 0) 6) (srfi-make-date 0 00 00 09 01 07 2012 3600)) (check-equal? (date+months (srfi-make-date 0 00 00 09 01 01 2100 0) 6) (srfi-make-date 0 00 00 09 01 07 2100 3600)) (check-equal? (date+months (srfi-make-date 0 00 00 09 01 01 2000 0) 6) (srfi-make-date 0 00 00 09 01 07 2000 3600)) (check-equal? (date+months (srfi-make-date 0 00 00 09 29 01 2010 0) 1) (srfi-make-date 0 00 00 09 01 03 2010 0))
(check-equal? (date+months (srfi-make-date 0 00 00 09 29 01 2010 0) 2) (srfi-make-date 0 00 00 09 29 03 2010 3600))
(check-equal? (date+months (srfi-make-date 0 00 00 09 29 01 2012 0) 1) (srfi-make-date 0 00 00 09 29 02 2012 0))
(check-equal? (date+months (srfi-make-date 0 00 00 09 29 01 2012 0) 2) (srfi-make-date 0 00 00 09 29 03 2012 3600)))
(test-case "date+years"
(check-equal? (date+years (srfi-make-date 0 00 00 09 01 01 2010 0) 1) (srfi-make-date 0 00 00 09 01 01 2011 0))
(check-equal? (date+years (srfi-make-date 0 00 00 09 01 01 2010 0) -11) (srfi-make-date 0 00 00 09 01 01 1999 0))
(check-equal? (date+years (srfi-make-date 0 00 00 09 01 01 2010 3600) -2011) (srfi-make-date 0 00 00 09 01 01 -1 -75)))
(test-case "normalize-date"
(with-time-zone "GB"
(check-equal? (normalize-date (srfi-make-date 0 00 00 09 01 01 2010 3600)) (srfi-make-date 0 00 00 08 01 01 2010 0))
(check-equal? (normalize-date (srfi-make-date 0 00 00 09 01 07 2010 0)) (srfi-make-date 0 00 00 10 01 07 2010 3600)))
(with-time-zone "PST8PDT"
(check-equal? (normalize-date (srfi-make-date 0 00 00 09 01 01 2010 3600)) (srfi-make-date 0 00 00 00 01 01 2010 -28800))
(check-equal? (normalize-date (srfi-make-date 0 00 00 09 01 07 2010 0)) (srfi-make-date 0 00 00 02 01 07 2010 -25200)))))