1 |
root |
1.1 |
BEGIN { $| = 1; print "1..77\n"; } |
2 |
|
|
|
3 |
|
|
# examples from rfc7049 |
4 |
|
|
|
5 |
|
|
use Data::Dumper; |
6 |
|
|
use CBOR::XS; |
7 |
|
|
|
8 |
|
|
binmode DATA; |
9 |
|
|
binmode STDOUT, ":utf8"; |
10 |
|
|
|
11 |
|
|
sub ok($;$) { |
12 |
|
|
print $_[0] ? "" : "not ", "ok ", ++$test, " - $_[1]\n"; |
13 |
|
|
} |
14 |
|
|
|
15 |
|
|
$Data::Dumper::Terse = 1; |
16 |
|
|
$Data::Dumper::Sortkeys = 1; |
17 |
|
|
$Data::Dumper::Pair = ','; |
18 |
|
|
$Data::Dumper::Useqq = 1; |
19 |
|
|
$Data::Dumper::Indent = 0; |
20 |
|
|
|
21 |
|
|
while (<DATA>) { |
22 |
|
|
next unless /^([<>\+*])\s*(.*?)\s*0x([0-9a-f]+)$/; |
23 |
|
|
my ($dir, $val, $hex) = ($1, $2, $3); |
24 |
|
|
|
25 |
|
|
my $src = $val; |
26 |
|
|
$src =~ y/_//d; |
27 |
|
|
utf8::decode $src if $src =~ /[\x80-\xff]/; |
28 |
|
|
|
29 |
|
|
my $bin = pack "H*", $hex; |
30 |
|
|
|
31 |
|
|
if ($dir eq "+") { |
32 |
|
|
my $dec = decode_cbor $bin; |
33 |
|
|
my $str = $dec; |
34 |
|
|
ok ($str eq $src, "<$dir,$val,$hex> dec <$str> eq <$src>"); |
35 |
|
|
my $enc = unpack "H*", encode_cbor $dec; |
36 |
|
|
ok ($enc eq $hex, "<$dir,$val,$hex> enc <$enc> eq <$hex>"); |
37 |
|
|
} |
38 |
|
|
|
39 |
|
|
if ($dir eq "<") { |
40 |
|
|
my $dec = decode_cbor $bin; |
41 |
|
|
my $str = $dec; |
42 |
|
|
|
43 |
|
|
$str = Dumper $str if ref $str; |
44 |
|
|
|
45 |
|
|
ok ($str eq $src, "<$dir,$val,$hex> dec <$str> eq <$src>"); |
46 |
|
|
} |
47 |
|
|
#$src = eval $src if $src =~ /^[\[\{]/; |
48 |
|
|
|
49 |
|
|
if ($dir eq "*") { |
50 |
|
|
my $dec = decode_cbor $bin; |
51 |
|
|
my $enc = unpack "H*", encode_cbor $dec; |
52 |
|
|
ok ($enc eq $hex, "<$dir,$val,$hex> enc <$enc> eq <$hex>"); |
53 |
|
|
} |
54 |
|
|
|
55 |
|
|
} |
56 |
|
|
|
57 |
|
|
# first char |
58 |
|
|
# < decode, check |
59 |
|
|
# + decode, check, encode, check |
60 |
|
|
# * decode, encode, check |
61 |
|
|
|
62 |
|
|
__DATA__ |
63 |
|
|
+ 0 0x00 |
64 |
|
|
+ 1 0x01 |
65 |
|
|
+ 10 0x0a |
66 |
|
|
+ 23 0x17 |
67 |
|
|
+ 24 0x1818 |
68 |
|
|
+ 25 0x1819 |
69 |
|
|
+ 100 0x1864 |
70 |
|
|
+ 1000 0x1903e8 |
71 |
|
|
+ 1000000 0x1a000f4240 |
72 |
|
|
+ 1000000000000 0x1b000000e8d4a51000 |
73 |
|
|
18446744073709551615 0x1bffffffffffffffff |
74 |
|
|
18446744073709551616 0xc249010000000000000000 |
75 |
|
|
-18446744073709551616 0x3bffffffffffffffff |
76 |
|
|
-18446744073709551617 0xc349010000000000000000 |
77 |
|
|
+ -1 0x20 |
78 |
|
|
+ -10 0x29 |
79 |
|
|
+ -100 0x3863 |
80 |
|
|
+ -1000 0x3903e7 |
81 |
|
|
< 0 0xf90000 |
82 |
|
|
-0 0xf98000 |
83 |
|
|
< 1 0xf93c00 |
84 |
|
|
+ 1.1 0xfb3ff199999999999a |
85 |
|
|
< 1.5 0xf93e00 |
86 |
|
|
< 65504 0xf97bff |
87 |
|
|
< 100000 0xfa47c35000 |
88 |
|
|
* 3.4028234663852886e+38 0xfa7f7fffff |
89 |
|
|
+ 1e+300 0xfb7e37e43c8800759c |
90 |
|
|
5.960464477539063e-8 0xf90001 |
91 |
|
|
0.00006103515625 0xf90400 |
92 |
|
|
< -4 0xf9c400 |
93 |
|
|
+ -4.1 0xfbc010666666666666 |
94 |
|
|
Infinity 0xf97c00 |
95 |
|
|
NaN 0xf97e00 |
96 |
|
|
-Infinity 0xf9fc00 |
97 |
|
|
* Infinity 0xfa7f800000 |
98 |
|
|
NaN 0xfa7fc00000 |
99 |
|
|
* -Infinity 0xfaff800000 |
100 |
|
|
Infinity 0xfb7ff0000000000000 |
101 |
|
|
* NaN 0xfb7ff8000000000000 |
102 |
|
|
-Infinity 0xfbfff0000000000000 |
103 |
|
|
* false 0xf4 |
104 |
|
|
* true 0xf5 |
105 |
|
|
* null 0xf6 |
106 |
|
|
undefined 0xf7 |
107 |
|
|
simple(16) 0xf0 |
108 |
|
|
simple(24) 0xf818 |
109 |
|
|
simple(255) 0xf8ff |
110 |
|
|
0("2013-03-21T20:04:00Z") 0xc074323031332d30332d32315432303a30343a30305a |
111 |
|
|
1(1363896240) 0xc11a514b67b0 |
112 |
|
|
1(1363896240.5) 0xc1fb41d452d9ec200000 |
113 |
|
|
23(h'01020304') 0xd74401020304 |
114 |
|
|
24(h'6449455446') 0xd818456449455446 |
115 |
|
|
32("http://www.example.com") 0xd82076687474703a2f2f7777772e6578616d706c652e636f6d |
116 |
|
|
h'' 0x40 |
117 |
|
|
h'01020304' 0x4401020304 |
118 |
|
|
"" 0x60 |
119 |
|
|
+ a 0x6161 |
120 |
|
|
+ IETF 0x6449455446 |
121 |
|
|
+ "\ 0x62225c |
122 |
|
|
+ ü 0x62c3bc |
123 |
|
|
+ 水 0x63e6b0b4 |
124 |
|
|
+ 𐅑 0x64f0908591 |
125 |
|
|
* [] 0x80 |
126 |
|
|
* [1,2,3] 0x83010203 |
127 |
|
|
* [1,[2,3],[4,5]] 0x8301820203820405 |
128 |
|
|
* [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25]0x98190102030405060708090a0b0c0d0e0f101112131415161718181819 |
129 |
|
|
* {} 0xa0 |
130 |
|
|
< {1,2,3,4} 0xa201020304 |
131 |
|
|
< {"a",1,"b",[2,3]} 0xa26161016162820203 |
132 |
|
|
< ["a",{"b","c"}] 0x826161a161626163 |
133 |
|
|
< {"a","A","b","B","c","C","d","D","e","E"}0xa56161614161626142616361436164614461656145 |
134 |
|
|
(_h'0102',h'030405') 0x5f42010243030405ff |
135 |
|
|
< streaming 0x7f657374726561646d696e67ff |
136 |
|
|
< [_] 0x9fff |
137 |
|
|
< [_1,[2,3],[_4,5]] 0x9f018202039f0405ffff |
138 |
|
|
< [_1,[2,3],[4,5]] 0x9f01820203820405ff |
139 |
|
|
< [1,[2,3],[_4,5]] 0x83018202039f0405ff |
140 |
|
|
< [1,[_2,3],[4,5]] 0x83019f0203ff820405 |
141 |
|
|
< [_1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25]0x9f0102030405060708090a0b0c0d0e0f101112131415161718181819ff |
142 |
|
|
< {_"a",1,"b",[_2,3]} 0xbf61610161629f0203ffff |
143 |
|
|
< ["a",{_"b","c"}] 0x826161bf61626163ff |
144 |
|
|
{_"Fun",true,"Amt",-2} 0xbf6346756ef563416d7421ff |
145 |
|
|
|