#lang scheme/base ;; Tests by Will Fitzgerald, augmented by: ;; John Clements -- 2004-08-16 ;; Dave Gurnell (string->date, date->string) -- 2007-09-14 ;; Dave Gurnell (time{=,<,>,<=,>=}?) -- 2009-11-26 ;; John Clements (nanoseconds off by x100) -- 2009-12-15 ;; Dave Gurnell (serializable dates and times) -- 2010-03-03 ;; Dave Gurnell (added ~x for string->date) -- 2010-03-10 (require scheme/serialize srfi/19/time) (require rackunit rackunit/text-ui) (define-check (check-comparisons comparison times expected) (for ([time0 (in-list times)] [expected (in-list expected)]) (for ([time1 (in-list times)] [expected (in-list expected)]) (with-check-info (['comparison comparison] ['time0 time0] ['time1 time1]) (let ([actual (comparison time0 time1)]) (check-equal? actual expected)))))) (define cur-tz (date-zone-offset (current-date))) ; Test suite ------------------------------------- (define srfi-19-test-suite (test-suite "Tests for SRFI 19" (test-not-exn "Creating time structures" (lambda () (list (current-time 'time-tai) (current-time 'time-utc) (current-time 'time-monotonic) (current-time 'time-thread) (current-time 'time-process)))) (test-not-exn "Testing time resolutions" (lambda () (list (time-resolution 'time-tai) (time-resolution 'time-utc) (time-resolution 'time-monotonic) (time-resolution 'time-thread) (time-resolution 'time-process)))) (test-case "Time comparisons (time=?, etc.)" (let ([t0 (make-time 'time-utc 0 1)] [t1 (make-time 'time-utc 0 1)] [t2 (make-time 'time-utc 1 1)] [t3 (make-time 'time-utc 0 2)]) (check-comparisons time=? (list t0 t1 t2 t3) '((#t #t #f #f) (#t #t #f #f) (#f #f #t #f) (#f #f #f #t))) (check-comparisons time? (list t0 t1 t2 t3) '((#f #f #f #f) (#f #f #f #f) (#t #t #f #f) (#t #t #t #f))) (check-comparisons time<=? (list t0 t1 t2 t3) '((#t #t #t #t) (#t #t #t #t) (#f #f #t #t) (#f #f #f #t))) (check-comparisons time>=? (list t0 t1 t2 t3) '((#t #t #f #f) (#t #t #f #f) (#t #t #t #f) (#t #t #t #t))))) (test-case "Time difference" (let ((t1 (make-time 'time-utc 0 3000)) (t2 (make-time 'time-utc 0 1000)) (t3 (make-time 'time-duration 0 2000)) (t4 (make-time 'time-duration 0 -2000))) (check time=? t3 (time-difference t1 t2)) (check time=? t4 (time-difference t2 t1)))) (test-case "TAI-UTC Conversions" (check-one-utc-tai-edge 915148800 32 31) (check-one-utc-tai-edge 867715200 31 30) (check-one-utc-tai-edge 820454400 30 29) (check-one-utc-tai-edge 773020800 29 28) (check-one-utc-tai-edge 741484800 28 27) (check-one-utc-tai-edge 709948800 27 26) (check-one-utc-tai-edge 662688000 26 25) (check-one-utc-tai-edge 631152000 25 24) (check-one-utc-tai-edge 567993600 24 23) (check-one-utc-tai-edge 489024000 23 22) (check-one-utc-tai-edge 425865600 22 21) (check-one-utc-tai-edge 394329600 21 20) (check-one-utc-tai-edge 362793600 20 19) (check-one-utc-tai-edge 315532800 19 18) (check-one-utc-tai-edge 283996800 18 17) (check-one-utc-tai-edge 252460800 17 16) (check-one-utc-tai-edge 220924800 16 15) (check-one-utc-tai-edge 189302400 15 14) (check-one-utc-tai-edge 157766400 14 13) (check-one-utc-tai-edge 126230400 13 12) (check-one-utc-tai-edge 94694400 12 11) (check-one-utc-tai-edge 78796800 11 10) (check-one-utc-tai-edge 63072000 10 0) (check-one-utc-tai-edge 0 0 0) ;; at the epoch (check-one-utc-tai-edge 10 0 0) ;; close to it ... (check-one-utc-tai-edge 1045789645 32 32)) ;; about now ... (test-case "TAI-Date Conversions" (check tm:date= (time-tai->date (make-time time-tai 0 (+ 915148800 29)) 0) (srfi:make-date 0 58 59 23 31 12 1998 0)) (check tm:date= (time-tai->date (make-time time-tai 0 (+ 915148800 30)) 0) (srfi:make-date 0 59 59 23 31 12 1998 0)) (check tm:date= (time-tai->date (make-time time-tai 0 (+ 915148800 31)) 0) (srfi:make-date 0 60 59 23 31 12 1998 0)) (check tm:date= (time-tai->date (make-time time-tai 0 (+ 915148800 32)) 0) (srfi:make-date 0 0 0 0 1 1 1999 0))) (test-case "Date-UTC Conversions" (check time=? (make-time time-utc 0 (- 915148800 2)) (date->time-utc (srfi:make-date 0 58 59 23 31 12 1998 0))) (check time=? (make-time time-utc 0 (- 915148800 1)) (date->time-utc (srfi:make-date 0 59 59 23 31 12 1998 0))) ;; yes, I think this is actually right. (check time=? (make-time time-utc 0 (- 915148800 0)) (date->time-utc (srfi:make-date 0 60 59 23 31 12 1998 0))) (check time=? (make-time time-utc 0 (- 915148800 0)) (date->time-utc (srfi:make-date 0 0 0 0 1 1 1999 0))) (check time=? (make-time time-utc 0 (+ 915148800 1)) (date->time-utc (srfi:make-date 0 1 0 0 1 1 1999 0)))) (test-case "TZ Offset conversions" (let ((ct-utc (make-time time-utc 6320000 1045944859)) (ct-tai (make-time time-tai 6320000 1045944891)) (cd (srfi:make-date 6320000 19 14 15 22 2 2003 -18000))) (check time=? ct-utc (date->time-utc cd)) (check time=? ct-tai (date->time-tai cd)))) ;; NOTE: documentation doesn't fully specify, e.g., zero-padding on ~c option, so I'm just going ;; to change the test case to match the implementation... (test-case "date->string conversions" (check-equal? (date->string (srfi:make-date 1000 2 3 4 5 6 2007 (* 60 -120)) "~~ @ ~a @ ~A @ ~b @ ~B @ ~c @ ~d @ ~D @ ~e @ ~f @ ~h @ ~H") "~ @ Tue @ Tuesday @ Jun @ June @ Tue Jun 05 04:03:02-0200 2007 @ 05 @ 06/05/07 @ 5 @ 02.000001 @ Jun @ 04")) (test-case "date->string conversions of dates with nanosecond components" (check-equal? (date->string (srfi:make-date 123456789 2 3 4 5 6 2007 0) "~N") "123456789") (check-equal? (date->string (srfi:make-date 12345678 2 3 4 5 6 2007 0) "~N") "012345678") (check-equal? (date->string (srfi:make-date 1234567 2 3 4 5 6 2007 0) "~N") "001234567") (check-equal? (date->string (srfi:make-date 123456 2 3 4 5 6 2007 0) "~N") "000123456") (check-equal? (date->string (srfi:make-date 12345 2 3 4 5 6 2007 0) "~N") "000012345") (check-equal? (date->string (srfi:make-date 1234 2 3 4 5 6 2007 0) "~N") "000001234") (check-equal? (date->string (srfi:make-date 123 2 3 4 5 6 2007 0) "~N") "000000123") (check-equal? (date->string (srfi:make-date 12 2 3 4 5 6 2007 0) "~N") "000000012") (check-equal? (date->string (srfi:make-date 1 2 3 4 5 6 2007 0) "~N") "000000001")) (test-case "string->date conversions of dates with nanosecond components" (check-equal? (string->date "12:00:00.123456789" "~H:~M:~S.~N") (srfi:make-date 123456789 0 0 12 #t #t #t cur-tz) "check 1") (check-equal? (string->date "12:00:00.12345678" "~H:~M:~S.~N") (srfi:make-date 123456780 0 0 12 #t #t #t cur-tz) "check 2") (check-equal? (string->date "12:00:00.1234567" "~H:~M:~S.~N") (srfi:make-date 123456700 0 0 12 #t #t #t cur-tz) "check 3") (check-equal? (string->date "12:00:00.123456" "~H:~M:~S.~N") (srfi:make-date 123456000 0 0 12 #t #t #t cur-tz) "check 4") (check-equal? (string->date "12:00:00.12345" "~H:~M:~S.~N") (srfi:make-date 123450000 0 0 12 #t #t #t cur-tz) "check 5") (check-equal? (string->date "12:00:00.1234" "~H:~M:~S.~N") (srfi:make-date 123400000 0 0 12 #t #t #t cur-tz) "check 6") (check-equal? (string->date "12:00:00.123" "~H:~M:~S.~N") (srfi:make-date 123000000 0 0 12 #t #t #t cur-tz) "check 7") (check-equal? (string->date "12:00:00.12" "~H:~M:~S.~N") (srfi:make-date 120000000 0 0 12 #t #t #t cur-tz) "check 8") (check-equal? (string->date "12:00:00.1" "~H:~M:~S.~N") (srfi:make-date 100000000 0 0 12 #t #t #t cur-tz) "check 9") (check-equal? (string->date "12:00:00.123456789" "~H:~M:~S.~N") (srfi:make-date 123456789 0 0 12 #t #t #t cur-tz) "check 10") (check-equal? (string->date "12:00:00.012345678" "~H:~M:~S.~N") (srfi:make-date 12345678 0 0 12 #t #t #t cur-tz) "check 11") (check-equal? (string->date "12:00:00.001234567" "~H:~M:~S.~N") (srfi:make-date 1234567 0 0 12 #t #t #t cur-tz) "check 12") (check-equal? (string->date "12:00:00.000123456" "~H:~M:~S.~N") (srfi:make-date 123456 0 0 12 #t #t #t cur-tz) "check 13") (check-equal? (string->date "12:00:00.000012345" "~H:~M:~S.~N") (srfi:make-date 12345 0 0 12 #t #t #t cur-tz) "check 14") (check-equal? (string->date "12:00:00.000001234" "~H:~M:~S.~N") (srfi:make-date 1234 0 0 12 #t #t #t cur-tz) "check 15") (check-equal? (string->date "12:00:00.000000123" "~H:~M:~S.~N") (srfi:make-date 123 0 0 12 #t #t #t cur-tz) "check 16") (check-equal? (string->date "12:00:00.000000012" "~H:~M:~S.~N") (srfi:make-date 12 0 0 12 #t #t #t cur-tz) "check 17") (check-equal? (string->date "12:00:00.000000001" "~H:~M:~S.~N") (srfi:make-date 1 0 0 12 #t #t #t cur-tz) "check 18")) (test-case "interpretation of 1- to 4-digit years by ~y, ~Y and ~?:" ; ~y: (check-exn exn:fail? (lambda () (string->date "1-03-02" "~y-~m-~d"))) (check-not-exn (lambda () (check-equal? (string->date "10-03-02" "~y-~m-~d") (srfi:make-date 0 0 0 0 2 3 2010 cur-tz)))) (check-exn exn:fail? (lambda () (string->date "100-03-02" "~y-~m-~d"))) (check-exn exn:fail? (lambda () (string->date "1000-03-02" "~y-~m-~d"))) ; ~Y: (check-not-exn (lambda () (check-equal? (string->date "1-03-02" "~Y-~m-~d") (srfi:make-date 0 0 0 0 2 3 1 cur-tz)))) (check-not-exn (lambda () (check-equal? (string->date "10-03-02" "~Y-~m-~d") (srfi:make-date 0 0 0 0 2 3 10 cur-tz)))) (check-not-exn (lambda () (check-equal? (string->date "100-03-02" "~Y-~m-~d") (srfi:make-date 0 0 0 0 2 3 100 cur-tz)))) (check-not-exn (lambda () (check-equal? (string->date "1000-03-02" "~Y-~m-~d") (srfi:make-date 0 0 0 0 2 3 1000 cur-tz)))) ; ~? (PLT-specific extension for 2- or 4-digit years: (check-not-exn (lambda () (check-equal? (string->date "1-03-02" "~?-~m-~d") (srfi:make-date 0 0 0 0 2 3 2001 cur-tz)))) (check-not-exn (lambda () (check-equal? (string->date "10-03-02" "~?-~m-~d") (srfi:make-date 0 0 0 0 2 3 2010 cur-tz)))) (check-not-exn (lambda () (check-equal? (string->date "100-03-02" "~?-~m-~d") (srfi:make-date 0 0 0 0 2 3 100 cur-tz)))) (check-not-exn (lambda () (check-equal? (string->date "1000-03-02" "~?-~m-~d") (srfi:make-date 0 0 0 0 2 3 1000 cur-tz))))) (test-case "date<->julian-day conversion" (check = 365 (- (date->julian-day (srfi:make-date 0 0 0 0 1 1 2004 0)) (date->julian-day (srfi:make-date 0 0 0 0 1 1 2003 0)))) (let ([test-date (srfi:make-date 0 0 0 0 1 1 2003 -7200)]) (check tm:date= test-date (julian-day->date (date->julian-day test-date) -7200)))) (test-case "date->modified-julian-day conversion" (check = 365 (- (date->modified-julian-day (srfi:make-date 0 0 0 0 1 1 2004 0)) (date->modified-julian-day (srfi:make-date 0 0 0 0 1 1 2003 0)))) (let ([test-date (srfi:make-date 0 0 0 0 1 1 2003 -7200)]) (check tm:date= test-date (modified-julian-day->date (date->modified-julian-day test-date) -7200)))) (test-case "serialize and deserialize" (check-equal? (deserialize (serialize (make-time time-utc 0 1))) (make-time time-utc 0 1)) (check-equal? (deserialize (serialize (make-time time-tai 2 3))) (make-time time-tai 2 3)) (check-equal? (deserialize (serialize (srfi:make-date 0 1 2 3 4 5 6 7))) (srfi:make-date 0 1 2 3 4 5 6 7))) ;; nanosecnds off by a factor of 100... (test-case "nanosecond order-of-magnitude" ;; half a second should be within 1/10th of 10^9 / 2 nanoseconds (currently off by a factor of 100) (check-within (let ([t (date-nanosecond (current-date))]) (sleep 0.5) (abs (- (date-nanosecond (current-date)) t))) (* 1/2 (expt 10 9)) (* 1/10 (expt 10 9)))))) ; Helper checks and procedures ----------------- (define-simple-check (check-within actual expected epsilon) (< (abs (- actual expected)) epsilon)) (define-check (check-one-utc-tai-edge utc tai-diff tai-last-diff) (let* (;; right on the edge they should be the same (utc-basic (make-time 'time-utc 0 utc)) (tai-basic (make-time 'time-tai 0 (+ utc tai-diff))) (utc->tai-basic (time-utc->time-tai utc-basic)) (tai->utc-basic (time-tai->time-utc tai-basic)) ;; a second before they should be the old diff (utc-basic-1 (make-time 'time-utc 0 (- utc 1))) (tai-basic-1 (make-time 'time-tai 0 (- (+ utc tai-last-diff) 1))) (utc->tai-basic-1 (time-utc->time-tai utc-basic-1)) (tai->utc-basic-1 (time-tai->time-utc tai-basic-1)) ;; a second later they should be the new diff (utc-basic+1 (make-time 'time-utc 0 (+ utc 1))) (tai-basic+1 (make-time 'time-tai 0 (+ (+ utc tai-diff) 1))) (utc->tai-basic+1 (time-utc->time-tai utc-basic+1)) (tai->utc-basic+1 (time-tai->time-utc tai-basic+1)) ;; ok, let's move the clock half a month or so plus half a second (shy (* 15 24 60 60)) (hs (/ (expt 10 9) 2)) ;; a second later they should be the new diff (utc-basic+2 (make-time 'time-utc hs (+ utc shy))) (tai-basic+2 (make-time 'time-tai hs (+ (+ utc tai-diff) shy))) (utc->tai-basic+2 (time-utc->time-tai utc-basic+2)) (tai->utc-basic+2 (time-tai->time-utc tai-basic+2))) (check time=? utc-basic tai->utc-basic) (check time=? tai-basic utc->tai-basic) (check time=? utc-basic-1 tai->utc-basic-1) (check time=? tai-basic-1 utc->tai-basic-1) (check time=? utc-basic+1 tai->utc-basic+1) (check time=? tai-basic+1 utc->tai-basic+1) (check time=? utc-basic+2 tai->utc-basic+2) (check time=? tai-basic+2 utc->tai-basic+2))) (define (tm:date= d1 d2) (and (= (srfi:date-year d1) (srfi:date-year d2)) (= (srfi:date-month d1) (srfi:date-month d2)) (= (srfi:date-day d1) (srfi:date-day d2)) (= (srfi:date-hour d1) (srfi:date-hour d2)) (= (srfi:date-second d1) (srfi:date-second d2)) (= (date-nanosecond d1) (date-nanosecond d2)) (= (date-zone-offset d1) (date-zone-offset d2)))) ; Main module body ------------------------------- (run-tests srfi-19-test-suite)