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

Update SRFI-19 to add a few bug fixes from Dave that John missed. Update tests to catch more errors

Browse Source 
svn: r7746
This commit is contained in:
Noel Welsh 2007-11-16 17:56:56 +00:00
parent c1aca0833c
commit d1950e1614
2 changed files with 45 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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))

26
collects/srfi/19/time.ss
View File

@ -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))