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