suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

srfi 19 tests, not for release

Browse Source 
svn: r17794
This commit is contained in:
John Clements 2010-01-24 07:23:09 +00:00
parent ba18a93fa6
commit a18447e970
1 changed files with 14 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/tests/srfi/19/tests.ss
View File

@ -4,6 +4,7 @@
;; John Clements -- 2004-08-16 ;; John Clements -- 2004-08-16
;; Dave Gurnell (string->date, date->string) -- 2007-09-14 ;; Dave Gurnell (string->date, date->string) -- 2007-09-14
;; Dave Gurnell (time{=,<,>,<=,>=}?) -- 2009-11-26 ;; Dave Gurnell (time{=,<,>,<=,>=}?) -- 2009-11-26
;; John Clements (nanoseconds off by x100) -- 2009-12-15
(require srfi/19/time) (require srfi/19/time)
@ -187,10 +188,22 @@
(check = 365 (- (date->modified-julian-day (srfi:make-date 0 0 0 0 1 1 2004 0)) (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)))) (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)]) (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)))))) (check tm:date= test-date (modified-julian-day->date (date->modified-julian-day test-date) -7200))))
;; 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 ----------------- ; 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) (define-check (check-one-utc-tai-edge utc tai-diff tai-last-diff)
(let* (;; right on the edge they should be the same (let* (;; right on the edge they should be the same
(utc-basic (make-time 'time-utc 0 utc)) (utc-basic (make-time 'time-utc 0 utc))