Parsing patch from Dave Gurnell

svn: r18671

collects/srfi/19/time.ss

@@ -1493,6 +1493,9 @@
 		       (char=? c #\-)))
 	     tm:zone-reader (lambda (val object)
 			      (tm:set-date-zone-offset! object val)))
+       ; PLT-specific extension for 2- or 4-digit years:
+       (list #\? char-numeric? ireader4 (lambda (val object)
+                                          (tm:set-date-year! object (tm:natural-year val))))
        )))
   
   (define (tm:string->date date index format-string str-len port template-string)

collects/tests/srfi/19/tests.ss

@@ -1,11 +1,12 @@
 #lang scheme/base
 
 ;; Tests by Will Fitzgerald, augmented by:
-;;   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
+;;   John Clements (nanoseconds off by x100)      -- 2009-12-15
-
+;;   Dave Gurnell  (serializable dates and times) -- 2010-03-03
+;;   Dave Gurnell  (added ~x for string->date)    -- 2010-03-10
 (require scheme/serialize
          srfi/19/time)
 
@@ -148,7 +149,7 @@
     
     
     
-    (test-case "[DJG] date->string conversions of dates with nanosecond components"
+    (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")
       (check-equal? (date->string (srfi:make-date 1234567   2 3 4 5 6 2007 0) "~N") "001234567")
@@ -159,7 +160,7 @@
       (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 "[DJG] string->date conversions of dates with nanosecond components"
+    (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")
       (check-equal? (string->date "12:00:00.1234567"   "~H:~M:~S.~N") (srfi:make-date 123456700 0 0 12 #t #t #t cur-tz) "check 3")
@@ -179,6 +180,23 @@
       (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")))
+      (check-not-exn (lambda () (check-equal? (string->date   "10-03-02" "~y-~m-~d") (srfi:make-date 0 0 0 0 2 3 2010 cur-tz))))
+      (check-exn exn:fail? (lambda () (string->date  "100-03-02" "~y-~m-~d")))
+      (check-exn exn:fail? (lambda () (string->date "1000-03-02" "~y-~m-~d")))
+      ; ~Y:
+      (check-not-exn (lambda () (check-equal? (string->date    "1-03-02" "~Y-~m-~d") (srfi:make-date 0 0 0 0 2 3    1 cur-tz))))
+      (check-not-exn (lambda () (check-equal? (string->date   "10-03-02" "~Y-~m-~d") (srfi:make-date 0 0 0 0 2 3   10 cur-tz))))
+      (check-not-exn (lambda () (check-equal? (string->date  "100-03-02" "~Y-~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" "~Y-~m-~d") (srfi:make-date 0 0 0 0 2 3 1000 cur-tz))))
+      ; ~? (PLT-specific extension for 2- or 4-digit years:
+      (check-not-exn (lambda () (check-equal? (string->date    "1-03-02" "~?-~m-~d") (srfi:make-date 0 0 0 0 2 3 2001 cur-tz))))
+      (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 "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))))
@@ -198,17 +216,17 @@
     
     ;; 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)
+      ;; 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))])
+      (check-within (let ([t (date-nanosecond (current-date))])
-                               (sleep 0.5)
+                      (sleep 0.5)
-                               (abs (- (date-nanosecond (current-date)) t)))
+                      (abs (- (date-nanosecond (current-date)) t)))
-                             (* 1/2  (expt 10 9))
+                    (* 1/2  (expt 10 9))
-                             (* 1/10 (expt 10 9))))))
+                    (* 1/10 (expt 10 9))))))
 
 ; Helper checks and procedures -----------------
 
 (define-simple-check (check-within actual expected epsilon)
-    (< (abs (- actual expected)) epsilon))
+  (< (abs (- actual expected)) epsilon))
 
 (define-check (check-one-utc-tai-edge utc tai-diff tai-last-diff)
   (let* (;; right on the edge they should be the same

doc/srfi-std/srfi-19.html

@@ -463,6 +463,10 @@ sting as is; except escape characters (indicate by the tilde) indicate special c
 converters; implementations are free to extend this list.
 </DL>
 
+<H3>PLT-specific extensions</H3>
+
+<p>The <code>~?</code> wildcard is specific to the PLT implementation of <code>string-&gt;date</code>: it parses 1 and 2 digit years like <code>~y</code> and 3 and 4 digit years like <code>~Y</code>.</p>
+
 <TABLE ALIGN="CENTER" WIDTH="80%" summary="DATE->STRING conversion specifiers">
 <TR><TD COLSPAN="2"><HR WIDTH="100%"></TD></TR>
 <TR><TH>Ch</TH><TH>Conversion</TH></TR>
@@ -534,6 +538,7 @@ converters; implementations are free to extend this list.
 <TR><TD width="6%"><code>~y</code></TD><TD WIDTH="23%">any</TD><TD WIDTH="50%">2-digit year</TD><TD WIDTH="23%"><code>date-year</code> within 50 years</TD></TR>
 <TR><TD width="6%"><code>~Y</code></TD><TD WIDTH="23%">char-numeric?</TD><TD WIDTH="50%">year</TD><TD WIDTH="23%"><code>date-year</code></TD></TR>
 <TR><TD width="6%"><code>~z</code></TD><TD WIDTH="23%">any</TD><TD WIDTH="50%">time zone</TD><TD WIDTH="23%"><code>date-zone-offset</code></TD></TR>
+<TR><TD width="6%"><code>~?</code></TD><TD WIDTH="23%">char-numeric?</TD><TD WIDTH="50%">2-digit or 4-digit year (PLT-specific extension)</TD><TD WIDTH="23%"><code>date-year</code></TD></TR>
 <TR><TD COLSPAN="4"><HR WIDTH="100%"></TD></TR>
 <TR><TH COLSPAN="4">Table 2: <code>STRING->DATE</code> conversion specifiers</TH></TR>
 <TR><TD COLSPAN="4"><HR WIDTH="100%"></TD></TR>