From 1ae216ec94c78e7c93c24d70d1b5ad83169edcf2 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Mon, 14 Jan 2013 10:26:37 -0500 Subject: [PATCH] Delete trailing whitespace --- collects/srfi/19/time.rkt | 172 +++++++++++++++---------------- collects/tests/srfi/19/tests.rkt | 60 +++++------ 2 files changed, 116 insertions(+), 116 deletions(-) diff --git a/collects/srfi/19/time.rkt b/collects/srfi/19/time.rkt index 1ee4a051a3..95f941d0c8 100644 --- a/collects/srfi/19/time.rkt +++ b/collects/srfi/19/time.rkt @@ -12,30 +12,30 @@ ;;; Based on a corrected version by Will F. Feb/2003 ;; SRFI-19: Time Data Types and Procedures. -;; -;; Copyright (C) I/NET, Inc. (2000, 2002, 2003). All Rights Reserved. -;; Copyright (C) Neodesic Corporation (2000). All Rights Reserved. -;; -;; This document and translations of it may be copied and furnished to others, -;; and derivative works that comment on or otherwise explain it or assist in its -;; implementation may be prepared, copied, published and distributed, in whole or -;; in part, without restriction of any kind, provided that the above copyright -;; notice and this paragraph are included on all such copies and derivative works. -;; However, this document itself may not be modified in any way, such as by -;; removing the copyright notice or references to the Scheme Request For -;; Implementation process or editors, except as needed for the purpose of -;; developing SRFIs in which case the procedures for copyrights defined in the SRFI -;; process must be followed, or as required to translate it into languages other -;; than English. -;; -;; The limited permissions granted above are perpetual and will not be revoked -;; by the authors or their successors or assigns. -;; -;; This document and the information contained herein is provided on an "AS IS" -;; basis and THE AUTHOR AND THE SRFI EDITORS DISCLAIM ALL WARRANTIES, EXPRESS OR -;; IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTY THAT THE USE OF THE -;; INFORMATION HEREIN WILL NOT INFRINGE ANY RIGHTS OR ANY IMPLIED WARRANTIES OF -;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. +;; +;; Copyright (C) I/NET, Inc. (2000, 2002, 2003). All Rights Reserved. +;; Copyright (C) Neodesic Corporation (2000). All Rights Reserved. +;; +;; This document and translations of it may be copied and furnished to others, +;; and derivative works that comment on or otherwise explain it or assist in its +;; implementation may be prepared, copied, published and distributed, in whole or +;; in part, without restriction of any kind, provided that the above copyright +;; notice and this paragraph are included on all such copies and derivative works. +;; However, this document itself may not be modified in any way, such as by +;; removing the copyright notice or references to the Scheme Request For +;; Implementation process or editors, except as needed for the purpose of +;; developing SRFIs in which case the procedures for copyrights defined in the SRFI +;; process must be followed, or as required to translate it into languages other +;; than English. +;; +;; The limited permissions granted above are perpetual and will not be revoked +;; by the authors or their successors or assigns. +;; +;; This document and the information contained herein is provided on an "AS IS" +;; basis and THE AUTHOR AND THE SRFI EDITORS DISCLAIM ALL WARRANTIES, EXPRESS OR +;; IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTY THAT THE USE OF THE +;; INFORMATION HEREIN WILL NOT INFRINGE ANY RIGHTS OR ANY IMPLIED WARRANTIES OF +;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. ;; -- Racket implementation ;; @@ -43,13 +43,13 @@ ;; CURRENT-SECONDS, the DEFINE-STRUCT procedure (SRFI 9: Defining Record Types ;; could be used), and the constants tm:time-at-zero-seconds ;; and tm:julian-day-at-zero-seconds, which refer to the '0' of CURRENT-SECONDS. -;; -;; SRFI-6, String Ports, and SRFI-8, RECEIVE: Binding Multiple Values, +;; +;; SRFI-6, String Ports, and SRFI-8, RECEIVE: Binding Multiple Values, ;; are also used. Racket has String Ports built-in. The RECEIVE form ;; is copied below. ;; ; srfi-8: receive -;(require-library "synrule.rkt") -- PLT doesn't like DEFINE-SYNTAX. +;(require-library "synrule.rkt") -- PLT doesn't like DEFINE-SYNTAX. ;(define-syntax receive ; (syntax-rules () @@ -68,7 +68,7 @@ (provide time-tai time-utc time-monotonic time-thread time-process time-duration time-gc current-date current-julian-day current-modified-julian-day current-time time-resolution ;; Time object and accessors - make-time time? time-type time-nanosecond + make-time time? time-type time-nanosecond deserialize-info:tm:time-v0 time-second set-time-type! set-time-nanosecond! set-time-second! copy-time @@ -84,9 +84,9 @@ srfi:date-year date-zone-offset ;; This are not part of the date structure (as they are in the original Racket's date) srfi:date-year-day srfi:date-week-day date-week-number - + ;; The following procedures work with this modified version. - + ;; Time/Date/Julian Day/Modified Julian Day Converters date->julian-day date->modified-julian-day date->time-monotonic date->time-tai date->time-utc julian-day->date julian-day->time-monotonic julian-day->time-tai julian-day->time-utc modified-julian-day->date @@ -119,7 +119,7 @@ ;; the least specific one (this one *does* exist!, it comes with this srfi) don't worry: (load-bundle! (list 'srfi-19))) (set! localized? #t)) - + (localized-template 'srfi-19 message-name))) ;; Constants @@ -141,7 +141,7 @@ (define tm:locale-abbr-weekday-vector (vector 'sun 'mon 'tue 'wed 'thu 'fri 'sat)) (define tm:locale-long-weekday-vector (vector 'sunday 'monday 'tuesday 'wednesday 'thursday 'friday 'saturday)) -;; note empty string in 0th place. +;; note empty string in 0th place. (define tm:locale-abbr-month-vector (vector 'jan 'feb 'mar 'apr 'may 'jun 'jul 'aug 'sep 'oct 'nov @@ -151,7 +151,7 @@ 'march 'april 'may 'june 'july 'august 'september 'october - 'november 'december)) + 'november 'december)) (define tm:locale-pm 'pm) (define tm:locale-am 'am) @@ -171,7 +171,7 @@ (define tm:tai-epoch-in-jd 4881175/2) ; julian day number for 'the epoch' ;; A Very simple Error system for the time procedures -;; +;; (define tm:time-error-types '(invalid-clock-type unsupported-clock-type @@ -195,7 +195,7 @@ ;; and update as necessary. ;; this procedures reads the file in the abover ;; format and creates the leap second table -;; it also calls the almost standard, but not R5 procedures read-line +;; it also calls the almost standard, but not R5 procedures read-line ;; & open-input-string ;; ie (set! tm:leap-second-table (tm:read-tai-utc-date "tai-utc.dat")) @@ -208,7 +208,7 @@ (table '()) ) (let loop ((line (read-line port))) (unless (eq? line eof) - (let* ( (data (read (open-input-string (string-append "(" line ")")))) + (let* ( (data (read (open-input-string (string-append "(" line ")")))) (year (car data)) (jd (cadddr (cdr data))) (secs (cadddr (cdddr data))) ) @@ -260,7 +260,7 @@ (if (< utc-seconds (* (- 1972 1970) 365 tm:sid)) 0 (lsd tm:leap-second-table)))) -;; going from tai seconds to utc seconds ... +;; going from tai seconds to utc seconds ... (define (tm:leap-second-neg-delta tai-seconds) (letrec ( (lsd (lambda (table) (cond ((null? table) 0) @@ -271,7 +271,7 @@ (lsd tm:leap-second-table)))) (define-values (tm:time make-time time? tm:time-ref tm:time-set!) - (make-struct-type + (make-struct-type 'tm:time #f 3 0 #f (list (cons prop:serializable (make-serialize-info @@ -281,7 +281,7 @@ (time-second t))) #'deserialize-info:tm:time-v0 #f - (or (current-load-relative-directory) + (or (current-load-relative-directory) (current-directory))))) (make-inspector) #f null)) @@ -315,10 +315,10 @@ ;;; These should be rewritten to be OS specific. ;; ;; -- using GNU gettimeofday() would be useful here -- gets -;; second + millisecond +;; second + millisecond ;; let's pretend we do, using Racket's current-seconds & current-milliseconds ;; this is supposed to return UTC. -;; +;; (define (tm:get-time-of-day) (let* ((total-msecs (inexact->exact (floor (current-inexact-milliseconds))))) @@ -337,7 +337,7 @@ (define (tm:current-time-ms-time time-type proc) (let ((current-ms (proc))) - (make-time time-type + (make-time time-type (* (remainder current-ms 1000) 1000000) (quotient current-ms 1000000) ))) @@ -448,7 +448,7 @@ (begin (set-time-second! time3 0) (set-time-nanosecond! time3 0)) - (receive + (receive (nanos secs) (tm:nanoseconds->values (- (tm:time->nanoseconds time1) (tm:time->nanoseconds time2))) @@ -520,7 +520,7 @@ (set-time-type! time-out time-utc) (set-time-nanosecond! time-out (time-nanosecond time-in)) (set-time-second! time-out (- (time-second time-in) - (tm:leap-second-neg-delta + (tm:leap-second-neg-delta (time-second time-in)))) time-out) @@ -538,7 +538,7 @@ (set-time-type! time-out time-tai) (set-time-nanosecond! time-out (time-nanosecond time-in)) (set-time-second! time-out (+ (time-second time-in) - (tm:leap-second-delta + (tm:leap-second-delta (time-second time-in)))) time-out) @@ -617,7 +617,7 @@ (with-handlers ([exn:fail:contract? (lambda (e) (lax-date nanosecond second minute hour - day month year zone-offset))]) + day month year zone-offset))]) (date* second minute hour day month year ;; compute derived fields @@ -707,7 +707,7 @@ (else (tm:char-pos char str (+ index 1) len)))) -; return a string representing the decimal expansion of the fractional +; return a string representing the decimal expansion of the fractional ; portion of a number, limited by a specified precision (define (tm:decimal-expansion r precision) (let loop ([num (- r (round r))] @@ -715,7 +715,7 @@ (if (or (= p 0) (= num 0)) "" (let* ([num-times-10 (* 10 num)] - [round-num-times-10 (round num-times-10)]) + [round-num-times-10 (round num-times-10)]) (string-append (number->string (inexact->exact round-num-times-10)) (loop (- num-times-10 round-num-times-10) (- p 1))))))) @@ -818,7 +818,7 @@ (offset (date-zone-offset date)) ) (let ( (jdays (- (tm:encode-julian-day-number day month year) tm:tai-epoch-in-jd)) ) - (make-time + (make-time time-utc nanosecond (+ (* (- jdays 1/2) 24 60 60) @@ -845,7 +845,7 @@ (tm:leap-year? (srfi:date-year date))) ;; tm:year-day fixed: adding wrong number of days. -(define tm:month-assoc '((0 . 0) (1 . 31) (2 . 59) (3 . 90) (4 . 120) +(define tm:month-assoc '((0 . 0) (1 . 31) (2 . 59) (3 . 90) (4 . 120) (5 . 151) (6 . 181) (7 . 212) (8 . 243) (9 . 273) (10 . 304) (11 . 334))) @@ -860,7 +860,7 @@ (define (srfi:date-year-day date) (tm:year-day (srfi:date-day date) (srfi:date-month date) (srfi:date-year date))) -;; from calendar faq +;; from calendar faq (define (tm:week-day day month year) (let* ((a (quotient (- 14 month) 12)) (y (- year a)) @@ -887,7 +887,7 @@ (tm:days-before-first-week date day-of-week-starting-week)) 7)) -(define (current-date . tz-offset) +(define (current-date . tz-offset) (time-utc->date (current-time time-utc) (:optional tz-offset (tm:local-tz-offset)))) @@ -940,7 +940,7 @@ (define (time-tai->julian-day time) (unless (eq? (time-type time) time-tai) (tm:time-error 'time->date 'incompatible-time-types time)) - (+ (/ (+ (- (time-second time) + (+ (/ (+ (- (time-second time) (tm:leap-second-delta (time-second time))) (/ (time-nanosecond time) tm:nano)) tm:sid) @@ -954,7 +954,7 @@ (define (time-monotonic->julian-day time) (unless (eq? (time-type time) time-monotonic) (tm:time-error 'time->date 'incompatible-time-types time)) - (+ (/ (+ (- (time-second time) + (+ (/ (+ (- (time-second time) (tm:leap-second-delta (time-second time))) (/ (time-nanosecond time) tm:nano)) tm:sid) @@ -1002,7 +1002,7 @@ (time-utc->modified-julian-day (current-time time-utc))) ;; returns a string rep. of number N, of minimum LENGTH, -;; padded with character PAD-WITH. If PAD-WITH if #f, +;; padded with character PAD-WITH. If PAD-WITH if #f, ;; no padding is done, and it's as if number->string was used. ;; if string is longer than LENGTH, it's as if number->string was used. (define (tm:padding n pad-with length) @@ -1016,14 +1016,14 @@ str-len)) ) (do ((i 0 (+ i 1))) ((>= i (string-length str))) - (string-set! new-str (+ new-str-offset i) + (string-set! new-str (+ new-str-offset i) (string-ref str i))) new-str)))) (define (tm:last-n-digits i n) (abs (remainder i (expt 10 n)))) -(define (tm:locale-abbr-weekday n) +(define (tm:locale-abbr-weekday n) (localized-message (vector-ref tm:locale-abbr-weekday-vector n))) (define (tm:locale-long-weekday n) @@ -1058,9 +1058,9 @@ -;; do nothing. +;; do nothing. ;; Your implementation might want to do something... -;; +;; (define (tm:locale-print-time-zone date port) (values)) @@ -1084,10 +1084,10 @@ ;; the second is a procedure that takes the date, a padding character ;; (which might be #f), and the output port. ;; -(define tm:directives +(define tm:directives (list (cons #\~ (lambda (date pad-with port) (display #\~ port))) - + (cons #\a (lambda (date pad-with port) (display (tm:locale-abbr-weekday (srfi:date-week-day date)) port))) @@ -1208,7 +1208,7 @@ (display (tm:padding (date-week-number date 1) #\0 2) port)))) (cons #\y (lambda (date pad-with port) - (display (tm:padding (tm:last-n-digits + (display (tm:padding (tm:last-n-digits (srfi:date-year date) 2) pad-with 2) @@ -1245,45 +1245,45 @@ (display current-char port) (tm:date-printer date (+ index 1) format-string str-len port)) (if (= (+ index 1) str-len) ; bad format string. - (tm:time-error 'tm:date-printer 'bad-date-format-string + (tm:time-error 'tm:date-printer 'bad-date-format-string format-string) (let ( (pad-char? (string-ref format-string (+ index 1))) ) (cond ((char=? pad-char? #\-) (if (= (+ index 2) str-len) ; bad format string. - (tm:time-error 'tm:date-printer 'bad-date-format-string + (tm:time-error 'tm:date-printer 'bad-date-format-string format-string) - (let ( (formatter (tm:get-formatter + (let ( (formatter (tm:get-formatter (string-ref format-string (+ index 2)))) ) (if (not formatter) - (tm:time-error 'tm:date-printer 'bad-date-format-string + (tm:time-error 'tm:date-printer 'bad-date-format-string format-string) (begin (formatter date #f port) (tm:date-printer date (+ index 3) format-string str-len port)))))) - + ((char=? pad-char? #\_) (if (= (+ index 2) str-len) ; bad format string. - (tm:time-error 'tm:date-printer 'bad-date-format-string + (tm:time-error 'tm:date-printer 'bad-date-format-string format-string) - (let ( (formatter (tm:get-formatter + (let ( (formatter (tm:get-formatter (string-ref format-string (+ index 2)))) ) (if (not formatter) - (tm:time-error 'tm:date-printer 'bad-date-format-string + (tm:time-error 'tm:date-printer 'bad-date-format-string format-string) (begin (formatter date #\Space port) (tm:date-printer date (+ index 3) format-string str-len port)))))) (else - (let ( (formatter (tm:get-formatter + (let ( (formatter (tm:get-formatter (string-ref format-string (+ index 1)))) ) (if (not formatter) - (tm:time-error 'tm:date-printer 'bad-date-format-string + (tm:time-error 'tm:date-printer 'bad-date-format-string format-string) (begin (formatter date #\0 port) @@ -1331,7 +1331,7 @@ ;; read an fractional integer upto n characters long on port; upto -> #f if any length ;; -;; The return value is normalized to upto decimal places. For example, if upto is 9 and +;; The return value is normalized to upto decimal places. For example, if upto is 9 and ;; the string read is "123", the return value is 123000000. (define (tm:fractional-integer-reader upto port) (define (accum-int port accum nchars) @@ -1354,8 +1354,8 @@ (let ((ch (peek-char port))) (cond ((>= nchars n) accum) - ((eof-object? ch) - (tm:time-error 'string->date 'bad-date-template-string + ((eof-object? ch) + (tm:time-error 'string->date 'bad-date-template-string "Premature ending to integer read.")) ((char-numeric? ch) (set! padding-ok #f) @@ -1365,7 +1365,7 @@ (read-char port) ; consume padding (accum-int port accum (+ nchars 1))) (else ; padding where it shouldn't be - (tm:time-error 'string->date 'bad-date-template-string + (tm:time-error 'string->date 'bad-date-template-string "Non-numeric characters in integer read."))))) (accum-int port 0 0))) @@ -1374,8 +1374,8 @@ (lambda (port) (tm:integer-reader-exact n port))) -(define (tm:zone-reader port) - (let ( (offset 0) +(define (tm:zone-reader port) + (let ( (offset 0) (positive? #f) ) (let ( (ch (read-char port)) ) (when (eof-object? ch) @@ -1418,10 +1418,10 @@ (define (read-char-string) (let ((ch (peek-char port))) (if (char-alphabetic? ch) - (begin (write-char (read-char port) string-port) + (begin (write-char (read-char port) string-port) (read-char-string)) (get-output-string string-port)))) - (let* ( (str (read-char-string)) + (let* ( (str (read-char-string)) (index (indexer str)) ) (if index index (tm:time-error 'string->date 'bad-date-template-string @@ -1441,7 +1441,7 @@ ;; A List of formatted read directives. ;; Each entry is a list. -;; 1. the character directive; +;; 1. the character directive; ;; a procedure, which takes a character as input & returns ;; 2. #t as soon as a character on the input port is acceptable ;; for input, @@ -1450,7 +1450,7 @@ ;; 4. a action procedure, that takes the value (from 3.) and some ;; object (here, always the date) and (probably) side-effects it. ;; In some cases (e.g., ~A) the action is to do nothing -(define tm:read-directives +(define tm:read-directives (let ( (ireader4 (tm:make-integer-reader 4)) (ireader2 (tm:make-integer-reader 2)) (fireader9 (tm:make-fractional-integer-reader 9)) @@ -1468,7 +1468,7 @@ (char-fail (lambda (ch) #t)) (do-nothing (lambda (val object) (values))) ) - + (list (list #\~ char-fail (tm:make-char-id-reader #\~) do-nothing) (list #\a char-alphabetic? locale-reader-abbr-weekday do-nothing) @@ -1506,7 +1506,7 @@ (list #\S char-numeric? ireader2 (lambda (val object) (struct-copy lax-date object [second val]))) - (list #\y char-fail eireader2 + (list #\y char-fail eireader2 (lambda (val object) (struct-copy lax-date object [year (tm:natural-year val)]))) @@ -1586,6 +1586,6 @@ (if (tm:date-ok? newdate) (lax-date->date* newdate) (tm:time-error 'string->date 'bad-date-format-string (list "Incomplete date read. " newdate template-string))))) - - + + diff --git a/collects/tests/srfi/19/tests.rkt b/collects/tests/srfi/19/tests.rkt index f6bbc0955c..9e3f414351 100644 --- a/collects/tests/srfi/19/tests.rkt +++ b/collects/tests/srfi/19/tests.rkt @@ -2,7 +2,7 @@ ;; Tests by Will Fitzgerald, augmented by: ;; 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 ;; John Clements (nanoseconds off by x100) -- 2009-12-15 ;; Dave Gurnell (serializable dates and times) -- 2010-03-03 @@ -31,7 +31,7 @@ (define srfi-19-test-suite (test-suite "Tests for SRFI 19" - + (test-not-exn "Creating time structures" (lambda () (list (current-time 'time-tai) @@ -39,7 +39,7 @@ (current-time 'time-monotonic) (current-time 'time-thread) (current-time 'time-process)))) - + (test-not-exn "Testing time resolutions" (lambda () (list (time-resolution 'time-tai) @@ -47,7 +47,7 @@ (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)] @@ -73,7 +73,7 @@ (#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)) @@ -81,7 +81,7 @@ (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) @@ -109,7 +109,7 @@ (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)) @@ -119,7 +119,7 @@ (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))) @@ -132,24 +132,24 @@ (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 + + + ;; 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") @@ -160,7 +160,7 @@ (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") @@ -180,7 +180,7 @@ (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"))) @@ -197,27 +197,27 @@ (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 "type-like error on date->string" - (check-exn - (lambda (exn) + (check-exn + (lambda (exn) (regexp-match #px"expects type " - (exn-message exn))) + (exn-message exn))) (lambda () (date->string (srfi:make-date 1000 2 3 4 2 5 2011 (* 60 -120)) #t)))) - - + + (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)) @@ -248,7 +248,7 @@ 2004) (check-equal? (srfi:date-year (srfi:make-date 0 0 0 0 1 1 2004 0)) 2004)) - + ;; nanoseconds 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) @@ -269,19 +269,19 @@ (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)) @@ -290,7 +290,7 @@ (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)