4 files changed, 71 insertions(+), 24 deletions(-)

M common.rkt
M decode.rkt
M encode.rkt
M private/test_data.rkt

@@ 31,7 31,7 @@
 (provide cbor-config?
          cbor-config-tag-deserializers
          cbor-config-null-value
-         empty-config
+         cbor-empty-config
          with-cbor-tag-deserializer
          with-cbor-null)
 


@@ 39,7 39,7 @@
   (tag-deserializers
    null-value))
 
-(define empty-config (cbor-config #hasheqv() 'null))
+(define cbor-empty-config (cbor-config #hasheqv() 'null))
 
 (define (with-cbor-tag-deserializer config id deser)
   (define old-handlers (cbor-config-tag-deserializers config))

@@ 204,7 204,7 @@
 (define cbor-default-config
   (foldl (lambda (p config)
            (with-cbor-tag-deserializer config (car p) (cdr p)))
-         empty-config
+         cbor-empty-config
          `((2 . ,deserialize-bignum)
            (3 . ,deserialize-bigneg)
            (30 . ,deserialize-rational)


@@ 230,20 230,19 @@
            "private/test_data.rkt")
 
   (define (try-bytes bytes)
-    (cbor-read cbor-default-config (open-input-bytes bytes)))
+    (cbor-read cbor-empty-config (open-input-bytes bytes)))
 
   (define (try str)
     (try-bytes (hex-bytes str)))
 
   (test-case
-      "Deserialization - RFC 8949 Int and Bignum Examples"
+      "Deserialization - RFC 8949 Int Examples"
     (for ([pair (in-list int-bignum-examples)])
       (let ([expected (car pair)]
             [bytes (cdr pair)])
         (check-equal? (try-bytes bytes) expected)))
     ; bignums TODO move to common
-    (check-eqv? (try "c249010000000000000000") 18446744073709551616)
-    (check-eqv? (try "c349010000000000000000") -18446744073709551617))
+    )
 
   (test-case
       "Deserialization - RFC 8949 Float Examples"


@@ 311,21 310,25 @@
     (for ([pair (in-list simple-value-examples)])
       (let ([expected (car pair)]
             [bytes (cdr pair)])
-        (check-equal? (try-bytes bytes) expected))))
+        (check-equal? (try-bytes bytes) expected)))) 
 
   (test-case
       "Deserialization - RFC 8949 Tag Examples"
-    (check-equal? (try "c074323031332d30332d32315432303a30343a30305a")
-                  (cbor-tag 0 "2013-03-21T20:04:00Z"))
-    (check-equal? (try "c11a514b67b0") (cbor-tag 1 1363896240))
-    (check-equal? (try "c1fb41d452d9ec200000") (cbor-tag 1 1363896240.5))
-    (check-equal? (try "d74401020304") (cbor-tag 23 #"\1\2\3\4"))
-    (check-equal? (try "d818456449455446") (cbor-tag 24 #"\x64\x49\x45\x54\x46"))
-    (check-equal? (try "d82076687474703a2f2f7777772e6578616d706c652e636f6d")
-                  (cbor-tag 32 "http://www.example.com")))
+    (for ([pair (in-list tag-examples)])
+      (let ([expected (car pair)]
+            [bytes (cdr pair)])
+        (check-equal? (try-bytes bytes) expected))))
+
+  ;; Above tests should work on empty config. These rely on the default config
+
+  (define (try-bytes-default bytes)
+    (cbor-read cbor-default-config (open-input-bytes bytes)))
 
   (test-case
-      "Deserialization - Misc Tags"
-    (check-equal? (try "d81e820103") (/ 1 3)))
+      "Deserialization - Interpreted Tags"
+    (for ([pair (in-list interpreted-tag-examples)])
+      (let ([expected (car pair)]
+            [bytes (cdr pair)])
+        (check-equal? (try-bytes-default bytes) expected))))
 
   )

@@ 145,9 145,13 @@
 
   (define (try v)
     (define out (open-output-bytes))
-    (cbor-write empty-config v out)
+    (cbor-write cbor-empty-config v out)
     (get-output-bytes out))
 
+  (define (check-round-trip v)
+    (define ser (try v))
+    (check-equal? (cbor-read cbor-empty-config (open-input-bytes ser)) v 0))
+
   (test-case
       "Serialization - RFC 8949 Int and Bignum Examples"
     (for ([pair (in-list int-bignum-examples)])


@@ 155,6 159,25 @@
             [expected (cdr pair)])
         (check-equal? (try v) expected))))
 
+  #;(test-case
+      "Serialization - Floats"
+    (when (single-flonum-available?)
+      (parameterize ([read-single-flonum #t])
+        (for ([v (in-list (read (open-input-string "(0.0f1 -0.0f1 1.0f1 1.1f1 1.5f1 65504.0f1
+                            100000.0f1 3.4028234663852886f+38 1.0f+300
+                            5.960464477539063f-8 0.00006103515625f1
+                            -4.0f1 -4.1f1 +inf.f +nan.f -inf.f)")))])
+          (check-round-trip v)))))
+
+  (test-case
+      "Serialization - Doubles"
+    (define cases '(0.0 -0.0 1.0 1.1 1.5 65504.0
+                        100000.0 3.4028234663852886e+38 1.0e+300
+                        5.960464477539063e-8 0.00006103515625
+                        -4.0 -4.1 +inf.0 +nan.0 -inf.0))
+    (for ([v (in-list cases)])
+      (check-round-trip v)))
+
   (test-case
       "Serialization - RFC 8949 Bytestring and String Examples"
     (for ([pair (in-list bytes-string-examples)])


@@ 188,10 211,7 @@
         (check-equal? (try v) expected)))
 
     ; hashes have unspecified ordering, just check that it round trips
-    (let* ([data #hash(("a" . "A") ("b" . "B") ("c" . "C") ("d" . "D") ("e" . "E"))]
-           [ser (try data)]
-           [data2 (cbor-read cbor-default-config (open-input-bytes ser))])
-      (check-equal? data2 data)))
+    (check-round-trip #hash(("a" . "A") ("b" . "B") ("c" . "C") ("d" . "D") ("e" . "E"))))
 
   (test-case
       "Serialization - RFC 8949 Simple Value Examples"


@@ 200,4 220,11 @@
             [expected (cdr pair)])
         (check-equal? (try v) expected))))
 
+  (test-case
+      "Serialization - RFC 8949 Tag Examples"
+    (for ([pair (in-list tag-examples)])
+      (let ([v (car pair)]
+            [expected (cdr pair)])
+        (check-equal? (try v) expected))))
+
   )

@@ 5,7 5,7 @@
          "../common.rkt"
          "util.rkt")
 (provide bytes-string-examples int-bignum-examples simple-value-examples
-         list-examples map-mixed-examples)
+         list-examples map-mixed-examples tag-examples interpreted-tag-examples)
 
 ; vars here are lists of pairs (value, serialized form value)
 ; this file is only used for data that round trips, i.e. can be used to test both


@@ 57,6 57,16 @@
          (,(cbor-simple-value 16) . "f0")
          (,(cbor-simple-value 255) . "f8ff"))))
 
+(define tag-examples
+  (map (lambda (pair)
+         (cons (cbor-tag (caar pair) (cdar pair)) (hex-bytes (cdr pair))))
+       '(((0 . "2013-03-21T20:04:00Z") . "c074323031332d30332d32315432303a30343a30305a")
+         ((1 . 1363896240) . "c11a514b67b0")
+         ((1 . 1363896240.5) . "c1fb41d452d9ec200000")
+         ((23 . #"\1\2\3\4") . "d74401020304")
+         ((24 . #"\x64\x49\x45\x54\x46") . "d818456449455446")
+         ((32 . "http://www.example.com") . "d82076687474703a2f2f7777772e6578616d706c652e636f6d"))))
+
 (define list-examples
   (map (lambda (pair)
          (cons (car pair) (hex-bytes (cdr pair))))


@@ 71,3 81,10 @@
        '((#hash() . "a0")
          (#hash((1 . 2) (3 . 4)) . "a201020304")
          (("a" #hash(("b" . "c"))) . "826161a161626163"))))
+
+(define interpreted-tag-examples
+  (map (lambda (pair)
+         (cons (car pair) (hex-bytes (cdr pair))))
+       `((,(/ 1 3) . "d81e820103")
+         (18446744073709551616 . "c249010000000000000000")
+         (-18446744073709551617 . "c349010000000000000000"))))