Fixing PR13748

collects/tests/xml/test.rkt

@@ -751,11 +751,15 @@ END
                                   "another string"
                                   (true)))
                (assoc-pair "sixth-key"
-                           (array))))
+                           (array))
+               (assoc-pair "seventh-key"
+                           (data "some data"))
+               (assoc-pair "eighth-key"
+                           (date "2013-05-10T20:29:55Z"))))
       (define example-str #<<END
 <?xml version="1.0" encoding="UTF-8"?>
 <!DOCTYPE plist SYSTEM "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
-<plist version="0.9"><dict><key>first-key</key><string>just a string with some  whitespace in it</string><key>second-key</key><false /><key>third-key</key><dict /><key>fourth-key</key><dict><key>inner-key</key><real>3.432</real></dict><key>fifth-key</key><array><integer>14</integer><string>another string</string><true /></array><key>sixth-key</key><array /></dict></plist>
+<plist version="0.9"><dict><key>first-key</key><string>just a string with some  whitespace in it</string><key>second-key</key><false /><key>third-key</key><dict /><key>fourth-key</key><dict><key>inner-key</key><real>3.432</real></dict><key>fifth-key</key><array><integer>14</integer><string>another string</string><true /></array><key>sixth-key</key><array /><key>seventh-key</key><data>some data</data><key>eighth-key</key><date>2013-05-10T20:29:55Z</date></dict></plist>
 END
         )]
      (test-suite
@@ -819,4 +823,5 @@ END
              (plist-value? v))
             (test-plist-round-trip v))))))))
 
-(run-tests xml-tests)
+(module+ test
+  (run-tests xml-tests))

collects/xml/plist.rkt

@@ -3,18 +3,6 @@
          racket/contract
          xml)
 
-; a dict is (list 'dict assoc-pair ...)
-; an assoc-pair is (list 'assoc-pair key value)
-; a key is a string
-; a value is either: 
-;  a string,
-;  a boolean, 
-;  an integer : (list 'integer number)
-;  a real : (list 'real number)
-;  a dict, or
-;  an array : (list 'array value ...)
-; (we're ignoring data & date)
-
 (define (plist-dict? v)
   (and (list? v)
        (pair? v)
@@ -38,9 +26,10 @@
              [(real) (and (= (length v) 2)
                           (real? (cadr v)))]
              [(array) (andmap plist-value? (cdr v))]
+             [(data) (and (= (length v) 2) (string? (cadr v)))]
+             [(date) (and (= (length v) 2) (string? (cadr v)))]
              [else (plist-dict? v)]))))
 
-
 ; raise-plist-exn : string mark-set xexpr symbol -> ???
 (define (raise-plist-exn tag mark-set xexpr type)
   (raise (make-exn:fail:contract (string-append "badly formed '" tag "'")
@@ -85,6 +74,14 @@
               (expand-dict x))
          =>
          (lambda (x) x)]
+        [(and (eq? (car x) 'date)
+              (expand-date x))
+         =>
+         (lambda (x) x)]
+        [(and (eq? (car x) 'data)
+              (expand-data x))
+         =>
+         (lambda (x) x)]
         [(and (eq? (car x) 'array)
               (expand-array x))
          =>
@@ -108,6 +105,20 @@
         [else
          (raise-plist-exn "integer" (current-continuation-marks) x 'plist:integer)]))
 
+(define (expand-date x)
+  (cond [(and (eq? (car x) 'date)
+              (string? (cadr x)))
+         `(date ,(cadr x))]
+        [else
+         (raise-plist-exn "date" (current-continuation-marks) x 'plist:date)]))
+
+(define (expand-data x)
+  (cond [(and (eq? (car x) 'data)
+              (string? (cadr x)))
+         `(data ,(cadr x))]
+        [else
+         (raise-plist-exn "data" (current-continuation-marks) x 'plist:data)]))
+
 ; expand-array : xexpr -> xexpr
 (define (expand-array x)
   (cond [(and (eq? (car x) 'array)
@@ -160,7 +171,9 @@
     [(true false) value]
     [(integer real) (list (car value) (string->number (cadr value)))]
     [(dict) (collapse-dict value)]
-    [(array) (collapse-array value)]))
+    [(array) (collapse-array value)]
+    [(date) value]
+    [(data) value]))
 
 ; collapse-array : xexpr -> array
 (define (collapse-array xexpr)

collects/xml/xml.scrbl

@@ -425,6 +425,8 @@ value created by a @racket[_dict-expr] is a @deftech{plist dictionary}:
           (list 'false)
           (list 'integer integer)
           (list 'real real)
+          (list 'data string)
+          (list 'date string)
           dict-expr
           (list 'array pl-expr ...)]
 [dict-expr (list 'dict assoc-pair ...)]
@@ -466,7 +468,11 @@ Write a @tech{plist value} to the given port.}
                             "another string"
                             (true)))
          (assoc-pair "sixth-key"
-                     (array))))
+                     (array))
+         (assoc-pair "seventh-key"
+                     (data "some data"))
+         (assoc-pair "eighth-key"
+                     (date "2013-05-10T20:29:55Z"))))
 (define-values (in out) (make-pipe))
 (write-plist my-dict out)
 (close-output-port out)
@@ -503,6 +509,10 @@ indentation:
     </array>
     <key>sixth-key</key>
     <array />
+    <key>seventh-key</key>
+    <data>some data</data>
+    <key>eighth-key</key>
+    <date>2013-05-10T20:29:55Z</date>
   </dict>
 </plist>
 }|