More tests, integrate hobo to test fails

Note we skip the string test on the "complex" tests as they .
Sereal · Sep 4, 2012 · 97c58b3 · 97c58b3
1 parent 841152b
commit 97c58b3
Show file tree

Hide file tree

Showing 2 changed files with 99 additions and 9 deletions.
diff --git a/shared/author_tools/hobodecoder.pl b/shared/author_tools/hobodecoder.pl
@@ -56,6 +56,27 @@ sub parse_header {
   }
 }
 
+my ($len_f, $len_d, $len_D);
+sub parse_float {
+    $len_f||= length(pack("f",0));
+    my $v= substr($data,0,$len_f,"");
+    $done .= $v;
+    return unpack("f",$v);
+}
+sub parse_double {
+    $len_d||= length(pack("d",0));
+    my $v= substr($data,0,$len_d,"");
+    $done .= $v;
+    return unpack("d",$v);
+}
+sub parse_long_double {
+    $len_D||= eval { length(pack("D",0)) };
+    die "Long double not supported" unless $len_D;
+    my $v= substr($data,0,$len_D,"");
+    $done .= $v;
+    return unpack("D",$v);
+}
+
 sub parse_sv {
   my ($ind) = @_;
 
@@ -76,7 +97,7 @@ sub parse_sv {
     $o = 15-$o;
     printf "%06u: %02x %03s %sNEG: %i\n", $p, $o, $bv, $ind, $o;
   }
-  elsif ($o >= 64) {
+  elsif ($o >= SRL_HDR_ASCII_LOW) {
     $o -= 64;
     my $len = $o;
     my $str = substr($data, 0, $len, '');
@@ -89,6 +110,15 @@ sub parse_sv {
     $done .= $str;
     printf "%06u: %02x %03s %sSTRING".($o == SRL_HDR_STRING_UTF8 ? "_UTF8" : "")."(%u): '%s'\n", $p, $o, $bv, $ind, $l, $str;
   }
+  elsif ($o == SRL_HDR_FLOAT) {
+    printf "%06u: %02x %03s %sFLOAT(%f)\n", $p, $o, $bv, $ind, parse_float();
+  }
+  elsif ($o == SRL_HDR_DOUBLE) {
+    printf "%06u: %02x %03s %sDOUBLE(%f)\n", $p, $o, $bv, $ind, parse_double();
+  }
+  elsif ($o == SRL_HDR_LONG_DOUBLE) {
+    printf "%06u: %02x %03s %sLONG_DOUBLE(%f)\n", $p, $o, $bv, $ind, parse_long_double();
+  }
   elsif ($o == SRL_HDR_REFN) {
     printf "%06u: %02x %03s %sREFN\n", $p, $o, $bv, $ind;
     parse_sv($ind . "  ");

diff --git a/shared/t/lib/Sereal/TestSet.pm b/shared/t/lib/Sereal/TestSet.pm
@@ -447,6 +447,50 @@ our @ScalarRoundtripTests = (
   ["simple regexp", qr/foo/],
   ["regexp with inline modifiers", qr/(?i-xsm:foo)/],
   ["regexp with modifiers", qr/foo/i],
+  ["float", 123013.139],
+  ["negative float",-1234.59],
+  ["small float",0.41],
+  ["negative small float",-0.13],
+  ["small int", 123],
+  ["empty string", ''],
+  ["simple array", []],
+  ["empty hash", {}],
+  ["simple hash", { foo => 'bar' }],
+  ["undef value", { foo => bar => baz => undef }],
+  ["simple array", [ 1 ]],
+  ["nested simple", [ 1, [ 2 ] ] ],
+  ["deep nest", [1,2,[3,4,{5=>6,7=>{8=>[]},9=>{}},{},[]]]],
+  ["complex hash", {
+    foo => 123,
+    bar => -159.23 ,
+    'baz' =>"foo",
+    'bop \''=> "\10"
+    ,'bop \'\\'=> "\x{100}" ,
+    'bop \'x\\x'    =>"x\x{100}"   , 'bing' =>   "x\x{100}",
+    x=>'y', z => 'p', i=> '1', l=>" \10", m=>"\10 ", n => " \10 ",
+  }],
+  ["more complex", {
+    foo => [123],
+    "bar" => [-159.23 , { 'baz' => "foo", }, ],
+    'bop \''=> { "\10" => { 'bop \'\\'=> "\x{100}", h=>{
+    'bop \'x\\x'    =>"x\x{100}"   , 'bing' =>   "x\x{100}",
+    x=>'y',}, z => 'p' ,   }   ,
+    i    =>  '1' ,}, l=>" \10", m=>"\10 ", n => " \10 ",
+    o => undef ,p=>undef,
+  }],
+  ['var strings', [ "\$", "\@", "\%" ]],
+  [ "quote keys", { "" => '"', "'" => "" }],
+  [ "ref to foo", \"foo" ],
+  [ "double ref to foo", \\"foo"],
+  [ "refy array", \\["foo"]],
+  [ "reffy hash", \\\{foo=>\"bar"}],
+  [ "blessed array", bless(\[],"foo")],
+  [ "utf8 string", "123\\277ABC\\x{DF}456"],
+  [ "escaped string", "\\012\345\267\145123\\277ABC\\x{DF}456"],
+  [ "more escapes", "\\0123\0124"],
+  [ "ref to undef", \undef],
+  [ "negative big num", -4123456789],
+  [ "positive big num", 4123456789],
 );
 
 
@@ -511,15 +555,31 @@ sub run_roundtrip_tests {
       ok(defined $encoded2, "$name ($mname, encoded2 defined)");
       is_deeply($decoded, $data, "$name ($mname, decoded vs data)")
         or do {
-            Dump($decoded);
-            Dump($data);
+            if ($ENV{DEBUG_DUMP}) {
+                Dump($decoded);
+                Dump($data);
+            }
         };
-      is_string($encoded2, $encoded, "$name ($mname, encoded2 vs encoded)")
-        or do {
-            Dump($decoded);
-            Dump($data);
-        };
-
+      if ($name=~/complex/) {
+          is(length($encoded2), length($encoded),"$name ($mname, length encoded2 vs length encoded)");
+      } else {
+          is_string($encoded2, $encoded, "$name ($mname, encoded2 vs encoded)")
+            or do {
+                if ($ENV{DEBUG_DUMP}) {
+                    Dump($decoded);
+                    Dump($data);
+                } elsif ($ENV{DEBUG_HOBO}) {
+                    open my $pipe,"| perl -Mblib=../Encoder/blib -Mblib=../Decoder/blib author_tools/hobodecoder.pl -e"
+                        or die "Dead: $!";
+                    print $pipe $encoded;
+                    close $pipe;
+                    open $pipe,"| perl -Mblib=../Encoder/blib -Mblib=../Decoder/blib author_tools/hobodecoder.pl -e"
+                        or die "Dead: $!";
+                    print $pipe $encoded2;
+                    close $pipe;
+                }
+            };
+      }
     }
   } # end serialization method iteration
 }