fixed bugs per dave gurnell's observations
svn: r7334
This commit is contained in:
John Clements
parent
5de1d6e687
commit
5fb7a90786
|
|
@ -1,223 +1,221 @@
|
|||
(module tests mzscheme
|
||||
|
||||
;; tests by Will Fitzgerald, augmented by John Clements -- 2004-08-16
|
||||
;; Tests by Will Fitzgerald, augmented by John Clements -- 2004-08-16
|
||||
|
||||
;; these tests were built using schemeunit 2.0a (IIRC). Older versions
|
||||
;; of schemeunit don't support the same syntax for creating assertions.
|
||||
;; so when you try to run the tests and they fail miserably, that's probably
|
||||
;; why.
|
||||
|
||||
;;; simple test procedures
|
||||
(require (lib "time.ss" "srfi" "19")
|
||||
(lib "test.ss" "schemeunit") ; change to a planet reference
|
||||
(lib "text-ui.ss" "schemeunit") ; change to a planet reference
|
||||
)
|
||||
;; Updated to SchemeUnit 2 syntax by Dave Gurnell -- 2007-09-14
|
||||
|
||||
(define-simple-assertion (assert-not-exn-helper thunk)
|
||||
(with-handlers ([not-break-exn? (lambda (exn) #f)])
|
||||
(thunk)
|
||||
#t))
|
||||
(require (lib "time.ss" "srfi" "19"))
|
||||
|
||||
(define-syntax assert-not-exn
|
||||
(lambda (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ arg) (syntax/loc stx (assert-not-exn-helper (lambda () arg)))]
|
||||
[else (error 'assert-not-exn "assert-not-exn expects exactly one argument, received: ~v" stx)])))
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
(planet "text-ui.ss" ("schematics" "schemeunit.plt" 2)))
|
||||
|
||||
; 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 ((t1 (make-time 'time-utc 0 1))
|
||||
(t2 (make-time 'time-utc 0 1))
|
||||
(t3 (make-time 'time-utc 0 2))
|
||||
(t11 (make-time 'time-utc 1001 1))
|
||||
(t12 (make-time 'time-utc 1001 1))
|
||||
(t13 (make-time 'time-utc 1001 2)))
|
||||
(check time=? t1 t2)
|
||||
(check time>? t3 t2)
|
||||
(check time<? t2 t3)
|
||||
(check time>=? t1 t2)
|
||||
(check time>=? t3 t2)
|
||||
(check time<=? t1 t2)
|
||||
(check time<=? t2 t3)
|
||||
(check time=? t11 t12)
|
||||
(check time>? t13 t12)
|
||||
(check time<? t12 t13)
|
||||
(check time>=? t11 t12)
|
||||
(check time>=? t13 t12)
|
||||
(check time<=? t11 t12)
|
||||
(check time<=? t12 t13)))
|
||||
|
||||
(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)
|
||||
(make-srfi:date 0 58 59 23 31 12 1998 0))
|
||||
(check tm:date= (time-tai->date (make-time time-tai 0 (+ 915148800 30)) 0)
|
||||
(make-srfi:date 0 59 59 23 31 12 1998 0))
|
||||
(check tm:date= (time-tai->date (make-time time-tai 0 (+ 915148800 31)) 0)
|
||||
(make-srfi:date 0 60 59 23 31 12 1998 0))
|
||||
(check tm:date= (time-tai->date (make-time time-tai 0 (+ 915148800 32)) 0)
|
||||
(make-srfi: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 (make-srfi:date 0 58 59 23 31 12 1998 0)))
|
||||
(check time=? (make-time time-utc 0 (- 915148800 1))
|
||||
(date->time-utc (make-srfi: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 (make-srfi:date 0 60 59 23 31 12 1998 0)))
|
||||
(check time=? (make-time time-utc 0 (- 915148800 0))
|
||||
(date->time-utc (make-srfi:date 0 0 0 0 1 1 1999 0)))
|
||||
(check time=? (make-time time-utc 0 (+ 915148800 1))
|
||||
(date->time-utc (make-srfi: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 (make-srfi: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 (make-srfi: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
|
||||
"[DJG] date->string conversions of dates with nanosecond components"
|
||||
(check-equal? (date->string (make-srfi:date 123456789 2 3 4 5 6 2007 0) "~N") "123456789")
|
||||
(check-equal? (date->string (make-srfi:date 12345678 2 3 4 5 6 2007 0) "~N") "012345678")
|
||||
(check-equal? (date->string (make-srfi:date 1234567 2 3 4 5 6 2007 0) "~N") "001234567")
|
||||
(check-equal? (date->string (make-srfi:date 123456 2 3 4 5 6 2007 0) "~N") "000123456")
|
||||
(check-equal? (date->string (make-srfi:date 12345 2 3 4 5 6 2007 0) "~N") "000012345")
|
||||
(check-equal? (date->string (make-srfi:date 1234 2 3 4 5 6 2007 0) "~N") "000001234")
|
||||
(check-equal? (date->string (make-srfi:date 123 2 3 4 5 6 2007 0) "~N") "000000123")
|
||||
(check-equal? (date->string (make-srfi:date 12 2 3 4 5 6 2007 0) "~N") "000000012")
|
||||
(check-equal? (date->string (make-srfi:date 1 2 3 4 5 6 2007 0) "~N") "000000001"))
|
||||
|
||||
(test-case
|
||||
"date<->julian-day conversion"
|
||||
(check = 365 (- (date->julian-day (make-srfi:date 0 0 0 0 1 1 2004 0))
|
||||
(date->julian-day (make-srfi:date 0 0 0 0 1 1 2003 0))))
|
||||
(let ([test-date (make-srfi: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 (make-srfi:date 0 0 0 0 1 1 2004 0))
|
||||
(date->modified-julian-day (make-srfi:date 0 0 0 0 1 1 2003 0))))
|
||||
(let ([test-date (make-srfi: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))))
|
||||
|
||||
(define srfi-19-test-suite
|
||||
(make-test-suite
|
||||
"Tests for SRFI 19"
|
||||
|
||||
(make-test-case
|
||||
"Creating time structures"
|
||||
(assert-not-exn
|
||||
(list (current-time 'time-tai)
|
||||
(current-time 'time-utc)
|
||||
(current-time 'time-monotonic)
|
||||
(current-time 'time-thread)
|
||||
(current-time 'time-process))))
|
||||
|
||||
(make-test-case
|
||||
"Testing time resolutions"
|
||||
(assert-not-exn
|
||||
(list (time-resolution 'time-tai)
|
||||
(time-resolution 'time-utc)
|
||||
(time-resolution 'time-monotonic)
|
||||
(time-resolution 'time-thread)
|
||||
(time-resolution 'time-process))))
|
||||
|
||||
(make-test-case
|
||||
"Time comparisons (time=?, etc.)"
|
||||
(let ((t1 (make-time 'time-utc 0 1))
|
||||
(t2 (make-time 'time-utc 0 1))
|
||||
(t3 (make-time 'time-utc 0 2))
|
||||
(t11 (make-time 'time-utc 1001 1))
|
||||
(t12 (make-time 'time-utc 1001 1))
|
||||
(t13 (make-time 'time-utc 1001 2)))
|
||||
(assert time=? t1 t2)
|
||||
(assert time>? t3 t2)
|
||||
(assert time<? t2 t3)
|
||||
(assert time>=? t1 t2)
|
||||
(assert time>=? t3 t2)
|
||||
(assert time<=? t1 t2)
|
||||
(assert time<=? t2 t3)
|
||||
(assert time=? t11 t12)
|
||||
(assert time>? t13 t12)
|
||||
(assert time<? t12 t13)
|
||||
(assert time>=? t11 t12)
|
||||
(assert time>=? t13 t12)
|
||||
(assert time<=? t11 t12)
|
||||
(assert time<=? t12 t13)))
|
||||
|
||||
(make-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)))
|
||||
(assert time=? t3 (time-difference t1 t2))
|
||||
(assert time=? t4 (time-difference t2 t1))))
|
||||
|
||||
(make-test-case
|
||||
"TAI-UTC Conversions"
|
||||
(begin
|
||||
(test-one-utc-tai-edge 915148800 32 31)
|
||||
(test-one-utc-tai-edge 867715200 31 30)
|
||||
(test-one-utc-tai-edge 820454400 30 29)
|
||||
(test-one-utc-tai-edge 773020800 29 28)
|
||||
(test-one-utc-tai-edge 741484800 28 27)
|
||||
(test-one-utc-tai-edge 709948800 27 26)
|
||||
(test-one-utc-tai-edge 662688000 26 25)
|
||||
(test-one-utc-tai-edge 631152000 25 24)
|
||||
(test-one-utc-tai-edge 567993600 24 23)
|
||||
(test-one-utc-tai-edge 489024000 23 22)
|
||||
(test-one-utc-tai-edge 425865600 22 21)
|
||||
(test-one-utc-tai-edge 394329600 21 20)
|
||||
(test-one-utc-tai-edge 362793600 20 19)
|
||||
(test-one-utc-tai-edge 315532800 19 18)
|
||||
(test-one-utc-tai-edge 283996800 18 17)
|
||||
(test-one-utc-tai-edge 252460800 17 16)
|
||||
(test-one-utc-tai-edge 220924800 16 15)
|
||||
(test-one-utc-tai-edge 189302400 15 14)
|
||||
(test-one-utc-tai-edge 157766400 14 13)
|
||||
(test-one-utc-tai-edge 126230400 13 12)
|
||||
(test-one-utc-tai-edge 94694400 12 11)
|
||||
(test-one-utc-tai-edge 78796800 11 10)
|
||||
(test-one-utc-tai-edge 63072000 10 0)
|
||||
(test-one-utc-tai-edge 0 0 0) ;; at the epoch
|
||||
(test-one-utc-tai-edge 10 0 0) ;; close to it ...
|
||||
(test-one-utc-tai-edge 1045789645 32 32) ;; about now ...
|
||||
))
|
||||
|
||||
(make-test-case
|
||||
"TAI-Date Conversions"
|
||||
(begin
|
||||
(assert tm:date= (time-tai->date (make-time time-tai 0 (+ 915148800 29)) 0)
|
||||
(make-srfi:date 0 58 59 23 31 12 1998 0))
|
||||
(assert tm:date= (time-tai->date (make-time time-tai 0 (+ 915148800 30)) 0)
|
||||
(make-srfi:date 0 59 59 23 31 12 1998 0))
|
||||
(assert tm:date= (time-tai->date (make-time time-tai 0 (+ 915148800 31)) 0)
|
||||
(make-srfi:date 0 60 59 23 31 12 1998 0))
|
||||
(assert tm:date= (time-tai->date (make-time time-tai 0 (+ 915148800 32)) 0)
|
||||
(make-srfi:date 0 0 0 0 1 1 1999 0))))
|
||||
|
||||
|
||||
(make-test-case
|
||||
"Date-UTC Conversions"
|
||||
(begin
|
||||
(assert time=? (make-time time-utc 0 (- 915148800 2))
|
||||
(date->time-utc (make-srfi:date 0 58 59 23 31 12 1998 0)))
|
||||
(assert time=? (make-time time-utc 0 (- 915148800 1))
|
||||
(date->time-utc (make-srfi:date 0 59 59 23 31 12 1998 0)))
|
||||
;; yes, I think this is acutally right.
|
||||
(assert time=? (make-time time-utc 0 (- 915148800 0))
|
||||
(date->time-utc (make-srfi:date 0 60 59 23 31 12 1998 0)))
|
||||
(assert time=? (make-time time-utc 0 (- 915148800 0))
|
||||
(date->time-utc (make-srfi:date 0 0 0 0 1 1 1999 0)))
|
||||
(assert time=? (make-time time-utc 0 (+ 915148800 1))
|
||||
(date->time-utc (make-srfi:date 0 1 0 0 1 1 1999 0)))))
|
||||
|
||||
(make-test-case
|
||||
"TZ Offset conversions"
|
||||
(let ((ct-utc (make-time time-utc 6320000 1045944859))
|
||||
(ct-tai (make-time time-tai 6320000 1045944891))
|
||||
(cd (make-srfi:date 6320000 19 14 15 22 2 2003 -18000)))
|
||||
(assert time=? ct-utc (date->time-utc cd))
|
||||
(assert time=? ct-tai (date->time-tai cd))))
|
||||
|
||||
(make-test-case
|
||||
"date->string conversions"
|
||||
(begin
|
||||
(assert-equal? "~.Tue.Tuesday.Jun.June.Tue Jun 5 4:03:02-0200 2007.05.06/05/07. 5,2.000001,Jun.03"
|
||||
(date->string (make-srfi:date 1000 2 3 4 5 6 2007 -120)
|
||||
"~~.~a.~A.~b.~B.~c.~d.~D.~e,~f,~h.~H"))))
|
||||
|
||||
(make-test-case
|
||||
"date<->julian-day conversion"
|
||||
(begin (assert = 365 (- (date->julian-day (make-srfi:date 0 0 0 0 1 1 2004 0))
|
||||
(date->julian-day (make-srfi:date 0 0 0 0 1 1 2003 0))))
|
||||
(let ([test-date (make-srfi:date 0 0 0 0 1 1 2003 -7200)])
|
||||
(assert tm:date= test-date (julian-day->date (date->julian-day test-date) -7200)))))
|
||||
|
||||
(make-test-case
|
||||
"date->modified-julian-day conversion"
|
||||
(begin (assert = 365 (- (date->modified-julian-day (make-srfi:date 0 0 0 0 1 1 2004 0))
|
||||
(date->modified-julian-day (make-srfi:date 0 0 0 0 1 1 2003 0))))
|
||||
(let ([test-date (make-srfi:date 0 0 0 0 1 1 2003 -7200)])
|
||||
(assert tm:date= test-date (modified-julian-day->date (date->modified-julian-day test-date) -7200)))))
|
||||
))
|
||||
|
||||
; Helper checks and procedures -----------------
|
||||
|
||||
(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))
|
||||
|
||||
(define (test-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)))
|
||||
|
||||
(assert time=? utc-basic tai->utc-basic)
|
||||
(assert time=? tai-basic utc->tai-basic)
|
||||
(assert time=? utc-basic-1 tai->utc-basic-1)
|
||||
(assert time=? tai-basic-1 utc->tai-basic-1)
|
||||
(assert time=? utc-basic+1 tai->utc-basic+1)
|
||||
(assert time=? tai-basic+1 utc->tai-basic+1)
|
||||
(assert time=? utc-basic+2 tai->utc-basic+2)
|
||||
(assert time=? tai-basic+2 utc->tai-basic+2)))
|
||||
;; 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)))
|
||||
|
||||
(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))))
|
||||
(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))))
|
||||
|
||||
(test/text-ui srfi-19-test-suite)
|
||||
; Main module body -----------------------------
|
||||
|
||||
)
|
||||
(test/text-ui srfi-19-test-suite)
|
||||
|
||||
)
|
||||
|
|
|
|||
|
|
@ -358,6 +358,7 @@
|
|||
((eq? clock-type time-utc) 10000)
|
||||
((eq? clock-type time-monotonic) 10000)
|
||||
((eq? clock-type time-thread) 10000)
|
||||
((eq? clock-type time-process) 10000)
|
||||
((eq? clock-type time-gc) 10000)
|
||||
(else (tm:time-error 'time-resolution 'invalid-clock-type clock-type)))))
|
||||
|
||||
|
|
@ -1087,7 +1088,7 @@
|
|||
(newline port)))
|
||||
(cons #\N (lambda (date pad-with port)
|
||||
(display (tm:padding (date-nanosecond date)
|
||||
pad-with 7)
|
||||
pad-with 9)
|
||||
port)))
|
||||
(cons #\p (lambda (date pad-with port)
|
||||
(display (tm:locale-am/pm (srfi:date-hour date)) port)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user