view release on metacpan or  search on metacpan

t/50_rfc.t  view on Meta::CPAN

BEGIN { $| = 1; print "1..78\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