CBOR-XS/t/50_rfc.t

BEGIN { $| = 1; print "1..79\n"; }

# examples from rfc7049

use Data::Dumper;
use CBOR::XS;

binmode DATA;
binmode STDOUT, ":utf8";

my $test;

sub ok($;$) {
   print $_[0] ? "" : "not ", "ok ", ++$test, " - $_[1]\n";
}

$Data::Dumper::Terse     = 1;
$Data::Dumper::Sortkeys  = 1;
$Data::Dumper::Pair      = ',';
$Data::Dumper::Useqq     = 1;
$Data::Dumper::Indent    = 0;
$Data::Dumper::Quotekeys = 1;

while (<DATA>) {
   next unless /^([<>\+*])\s*(.*?)\s*0x([0-9a-f]+)$/;
   my ($dir, $val, $hex) = ($1, $2, $3);

   my $src = $val;
   $src =~ y/_//d;
   utf8::decode $src if $src =~ /[\x80-\xff]/;

   my $bin = pack "H*", $hex;

   if ($dir eq "+") {
      my $dec = decode_cbor $bin;
      my $str = $dec;
      ok ($str eq $src, "<$dir,$val,$hex> dec <$str> eq <$src>");
      my $enc = unpack "H*", encode_cbor $dec;
      ok ($enc eq $hex, "<$dir,$val,$hex> enc <$enc> eq <$hex>");
   }

   if ($dir eq "<") {
      my $dec = decode_cbor $bin;
      my $str = $dec;

      $str = Dumper $str if ref $str;

      ok ($str eq $src, "<$dir,$val,$hex> dec <$str> eq <$src>");
   }
   #$src = eval $src if $src =~ /^[\[\{]/;

   if ($dir eq "*") {
      my $dec = decode_cbor $bin;
      my $enc = unpack "H*", encode_cbor $dec;
      ok ($enc eq $hex, "<$dir,$val,$hex> enc <$enc> eq <$hex>");
   }

}

# first char
# < decode, check
# + decode, check, encode, check
# * decode, encode, check

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