diff --git a/collects/srfi/19/tests.ss b/collects/srfi/19/tests.ss index cfb3576fe2..87a9c4d210 100644 --- a/collects/srfi/19/tests.ss +++ b/collects/srfi/19/tests.ss @@ -4,7 +4,7 @@ ;; Updated to SchemeUnit 2 syntax by Dave Gurnell -- 2007-09-14 - (require (lib "time.ss" "srfi" "19")) + (require (file "time.ss")) (require (planet "test.ss" ("schematics" "schemeunit.plt" 2)) (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2))) @@ -149,7 +149,28 @@ (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 + "[DJG] string->date conversions of dates with nanosecond components" + (check-equal? (string->date "12:00:00.123456789" "~H:~M:~S.~N") (make-srfi:date 123456789 0 0 12 #t #t #t 0) "check 1") + (check-equal? (string->date "12:00:00.12345678" "~H:~M:~S.~N") (make-srfi:date 123456780 0 0 12 #t #t #t 0) "check 2") + (check-equal? (string->date "12:00:00.1234567" "~H:~M:~S.~N") (make-srfi:date 123456700 0 0 12 #t #t #t 0) "check 3") + (check-equal? (string->date "12:00:00.123456" "~H:~M:~S.~N") (make-srfi:date 123456000 0 0 12 #t #t #t 0) "check 4") + (check-equal? (string->date "12:00:00.12345" "~H:~M:~S.~N") (make-srfi:date 123450000 0 0 12 #t #t #t 0) "check 5") + (check-equal? (string->date "12:00:00.1234" "~H:~M:~S.~N") (make-srfi:date 123400000 0 0 12 #t #t #t 0) "check 6") + (check-equal? (string->date "12:00:00.123" "~H:~M:~S.~N") (make-srfi:date 123000000 0 0 12 #t #t #t 0) "check 7") + (check-equal? (string->date "12:00:00.12" "~H:~M:~S.~N") (make-srfi:date 120000000 0 0 12 #t #t #t 0) "check 8") + (check-equal? (string->date "12:00:00.1" "~H:~M:~S.~N") (make-srfi:date 100000000 0 0 12 #t #t #t 0) "check 9") + (check-equal? (string->date "12:00:00.123456789" "~H:~M:~S.~N") (make-srfi:date 123456789 0 0 12 #t #t #t 0) "check 10") + (check-equal? (string->date "12:00:00.012345678" "~H:~M:~S.~N") (make-srfi:date 12345678 0 0 12 #t #t #t 0) "check 11") + (check-equal? (string->date "12:00:00.001234567" "~H:~M:~S.~N") (make-srfi:date 1234567 0 0 12 #t #t #t 0) "check 12") + (check-equal? (string->date "12:00:00.000123456" "~H:~M:~S.~N") (make-srfi:date 123456 0 0 12 #t #t #t 0) "check 13") + (check-equal? (string->date "12:00:00.000012345" "~H:~M:~S.~N") (make-srfi:date 12345 0 0 12 #t #t #t 0) "check 14") + (check-equal? (string->date "12:00:00.000001234" "~H:~M:~S.~N") (make-srfi:date 1234 0 0 12 #t #t #t 0) "check 15") + (check-equal? (string->date "12:00:00.000000123" "~H:~M:~S.~N") (make-srfi:date 123 0 0 12 #t #t #t 0) "check 16") + (check-equal? (string->date "12:00:00.000000012" "~H:~M:~S.~N") (make-srfi:date 12 0 0 12 #t #t #t 0) "check 17") + (check-equal? (string->date "12:00:00.000000001" "~H:~M:~S.~N") (make-srfi:date 1 0 0 12 #t #t #t 0) "check 18")) + (test-case "date<->julian-day conversion" (check = 365 (- (date->julian-day (make-srfi:date 0 0 0 0 1 1 2004 0)) diff --git a/collects/srfi/19/time.ss b/collects/srfi/19/time.ss index 6424d7c10a..4afeeaec80 100644 --- a/collects/srfi/19/time.ss +++ b/collects/srfi/19/time.ss @@ -1250,6 +1250,24 @@ (lambda (port) (tm:integer-reader upto port))) + ;; 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 string read is "123", the return value is 123000000. + (define (tm:fractional-integer-reader upto port) + (define (accum-int port accum nchars) + (let ((ch (peek-char port))) + (if (or (eof-object? ch) + (not (char-numeric? ch)) + (and upto (>= nchars upto ))) + (* accum (expt 10 (- upto nchars))) + (accum-int port (+ (* accum 10) (tm:char->int (read-char port))) (+ nchars 1))))) + (accum-int port 0 0)) + + (define (tm:make-fractional-integer-reader upto) + (lambda (port) + (tm:fractional-integer-reader upto port))) + ;; read *exactly* n characters and convert to integer; could be padded (define (tm:integer-reader-exact n port) (let ( (padding-ok #t) ) @@ -1356,7 +1374,7 @@ (define tm:read-directives (let ( (ireader4 (tm:make-integer-reader 4)) (ireader2 (tm:make-integer-reader 2)) - (ireader7 (tm:make-integer-reader 7)) + (fireader9 (tm:make-fractional-integer-reader 9)) (ireaderf (tm:make-integer-reader #f)) (eireader2 (tm:make-integer-exact-reader 2)) (eireader4 (tm:make-integer-exact-reader 4)) @@ -1399,8 +1417,8 @@ (list #\M char-numeric? ireader2 (lambda (val object) (tm:set-date-minute! object val))) - (list #\N char-numeric? ireader7 (lambda (val object) - (tm:set-date-nanosecond! object val))) + (list #\N char-numeric? fireader9 (lambda (val object) + (tm:set-date-nanosecond! object val))) (list #\S char-numeric? ireader2 (lambda (val object) (tm:set-date-second! object val))) (list #\y char-fail eireader2 @@ -1439,7 +1457,7 @@ (tm:time-error 'string->date 'bad-date-format-string template-string) (let* ( (format-char (string-ref format-string (+ index 1))) (format-info (assoc format-char tm:read-directives)) ) - (if (not format-info) + (if (not format-info) (tm:time-error 'string->date 'bad-date-format-string template-string) (begin (let ((skipper (cadr format-info))