demerphq / data-dump-streamer Goto Github PK

diff --git a/lib/Data/Dump/Streamer.pm b/lib/Data/Dump/Streamer.pm
index 61f8f84..83e7015 100644
--- a/lib/Data/Dump/Streamer.pm
+++ b/lib/Data/Dump/Streamer.pm
@@ -35,7 +35,7 @@ $DEBUG=0;
 BEGIN{ $HasPadWalker=eval "use PadWalker 0.99; 1"; }
 
 BEGIN {
-    $VERSION   ='2.38';
+    $VERSION   ='2.40';
     $XS_VERSION = $VERSION;
     $VERSION = eval $VERSION; # used for beta stuff.
     @ISA       = qw(Exporter DynaLoader);
@@ -2765,6 +2765,9 @@ sub _dump_code {
         #$self->{fh}->print("\n#",join " ",keys %$used,"\n");
 
         #$code=~s/^\s*(\([^)]+\)|)\s*/sub$1\n/;
+
+        $code=~s/(\%\{)(\s*\{\}\s*)/$1;$2/g;
+
         $code="sub".($code=~/^\s*\(/ ? "" : " ").$code;
         if ($self->{style}{indent}) {
             $code=~s/\n/"\n"." " x $indent/meg;
@@ -3709,13 +3712,12 @@ sub _get_lexicals {
 
     my $svo=B::svref_2object($cv);
     my @pl_array = eval { $svo->PADLIST->ARRAY };
-
     my @name_obj = eval { $pl_array[0]->ARRAY };
 
     my %named;
     for my $i ( 0..$#name_obj ) {
         if ( ref($name_obj[$i])!~/SPECIAL/) {
-            $named{$i} = "${ $name_obj[$i]->object_2svref }";
+            $named{$i} = $name_obj[$i]->PV;
         }
     }
 
@@ -3748,7 +3750,7 @@ use B::Deparse;
 our @ISA=qw(B::Deparse);
 my %cache;
 
-our $VERSION = '2.38';
+our $VERSION = '2.40';
 $VERSION= eval $VERSION;
 if ( $VERSION ne $Data::Dump::Streamer::VERSION ) {
     die "Incompatible Data::Dump::Streamer::Deparser v$VERSION vs Data::Dump::Streamer v$Data::Dump::Streamer::VERSION";
diff --git a/t/globtest.t b/t/globtest.t
index 41cc4fb..5ff7c66 100644
--- a/t/globtest.t
+++ b/t/globtest.t
@@ -66,7 +66,25 @@ vec($_,@#,@#) = @<< == @######### @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 $off, $width, $bits, $val, $res
 .
 ';
-		same( scalar $o->Data(*g)->Out, <<'EXPECT', "data slots (glob/FORMAT)", $o );
+                if ( 5.021009 <= $] ) {
+		    same( scalar $o->Data(*g)->Out, <<'EXPECT', "data slots (glob/FORMAT)", $o );
+$VAR1 = *::g;
+*::g = \do { my $v = 'a string' };
+*::g = { a => 'hash' };
+*::g = [
+         'a',
+         'list'
+       ];
+format g =
+vec($_,@#,@#) = @<< == @######### @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+use warnings;
+; $off, $width, $bits, $val, $res
+vec($_,@#,@#) = @<< == @######### @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+$off, $width, $bits, $val, $res
+.
+EXPECT
+                } else {
+		    same( scalar $o->Data(*g)->Out, <<'EXPECT', "data slots (glob/FORMAT)", $o );
 $VAR1 = *::g;
 *::g = \do { my $v = 'a string' };
 *::g = { a => 'hash' };
@@ -81,12 +99,28 @@ vec($_,@#,@#) = @<< == @######### @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 $off, $width, $bits, $val, $res
 .
 EXPECT
+
+                }
                 SKIP: {
                     skip "no FORMAT refs before ".vstr(5,7)." and this is ".vstr(),
                          my $NUM=3
                        unless  5.008 <= $];
+                    if ( 5.021009 <= $] ) {
 
-		same( scalar $o->Data(*g{FORMAT})->Out, <<'EXPECT', "data slots (ref/FORMAT)", $o );
+		        same( scalar $o->Data(*g{FORMAT})->Out, <<'EXPECT', "data slots (ref/FORMAT)", $o );
+$FORMAT1 = do{ local *F; my $F=<<'_EOF_FORMAT_'; $F=~s/^\s+# //mg; eval $F; die $F.$@ if $@; *F{FORMAT};
+           # format F =
+           # vec($_,@#,@#) = @<< == @######### @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+           # use warnings;
+           # ; $off, $width, $bits, $val, $res
+           # vec($_,@#,@#) = @<< == @######### @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+           # $off, $width, $bits, $val, $res
+           # .
+_EOF_FORMAT_
+           };
+EXPECT
+                    } else {
+		        same( scalar $o->Data(*g{FORMAT})->Out, <<'EXPECT', "data slots (ref/FORMAT)", $o );
 $FORMAT1 = do{ local *F; my $F=<<'_EOF_FORMAT_'; $F=~s/^\s+# //mg; eval $F; die $F.$@ if $@; *F{FORMAT};
            # format F =
            # vec($_,@#,@#) = @<< == @######### @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -97,14 +131,35 @@ $FORMAT1 = do{ local *F; my $F=<<'_EOF_FORMAT_'; $F=~s/^\s+# //mg; eval $F; die
 _EOF_FORMAT_
            };
 EXPECT
-                my $y=bless *g{FORMAT},"Thank::YSTH";
-                #same ( scalar $o->Data(*g{FORMAT})->Out, <<'EXPECT', "data slots (blessed FORMAT)", $o );
-		test_dump( {name=>"data slots (blessed FORMAT)",
-		            verbose=>1,
-		            pre_eval=>'our ($off,$width,$bits,$val,$res);',
-		            no_dumper=>1
-		            },
-		             $o, *g{FORMAT}, <<'EXPECT'  );
+                    }
+                    my $y=bless *g{FORMAT},"Thank::YSTH";
+                    if ( 5.021009 <= $] ) {
+                        #same ( scalar $o->Data(*g{FORMAT})->Out, <<'EXPECT', "data slots (blessed FORMAT)", $o );
+		        test_dump( {name=>"data slots (blessed FORMAT)",
+		                    verbose=>1,
+		                    pre_eval=>'our ($off,$width,$bits,$val,$res);',
+		                    no_dumper=>1,
+                                    no_redump=>1,
+		                    },
+		                    $o, *g{FORMAT}, <<'EXPECT'  );
+$Thank_YSTH1 = bless( do{ local *F; my $F=<<'_EOF_FORMAT_'; $F=~s/^\s+# //mg; eval $F; die $F.$@ if $@; *F{FORMAT};
+               # format F =
+               # vec($_,@#,@#) = @<< == @######### @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+               # use warnings;
+               # ; $off, $width, $bits, $val, $res
+               # vec($_,@#,@#) = @<< == @######### @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+               # $off, $width, $bits, $val, $res
+               # .
+_EOF_FORMAT_
+               }, 'Thank::YSTH' );
+EXPECT
+                    } else {
+		        test_dump( {name=>"data slots (blessed FORMAT)",
+		                    verbose=>1,
+		                    pre_eval=>'our ($off,$width,$bits,$val,$res);',
+		                    no_dumper=>1,
+		                    },
+		                    $o, *g{FORMAT}, <<'EXPECT'  );
 $Thank_YSTH1 = bless( do{ local *F; my $F=<<'_EOF_FORMAT_'; $F=~s/^\s+# //mg; eval $F; die $F.$@ if $@; *F{FORMAT};
                # format F =
                # vec($_,@#,@#) = @<< == @######### @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -115,8 +170,10 @@ $Thank_YSTH1 = bless( do{ local *F; my $F=<<'_EOF_FORMAT_'; $F=~s/^\s+# //mg; ev
 _EOF_FORMAT_
                }, 'Thank::YSTH' );
 EXPECT
-    our $gg=1; #silence a warning;
-		same( scalar $o->Data(*gg{FORMAT})->Out, <<'EXPECT', "data slots (empty FORMAT)", $o );
+
+                    }
+                    our $gg=1; #silence a warning;
+		    same( scalar $o->Data(*gg{FORMAT})->Out, <<'EXPECT', "data slots (empty FORMAT)", $o );
 $VAR1 = undef;
 EXPECT
                 };
diff --git a/t/madness_json.t b/t/madness_json.t
index db13def..5fb055e 100644
--- a/t/madness_json.t
+++ b/t/madness_json.t
@@ -230,7 +230,7 @@ format STDOUT =
     else {
         $expected_dot = 'undef';
     }
-    my $jstrue= JSON::XS::decode_json("true");
+    my $jstrue= JSON::XS::decode_json("[true]")->[0];
     my %hash = (
         UND => undef,
         IV  => 1,
@@ -392,7 +392,7 @@ EXPECT
     }
     # In JSON::XS < 3, the boolean class is JSON::XS::Boolean
     # In JSON::XS >= 3, the boolean class is JSON::PP::Boolean
-    my $json_boolean_class = ref JSON::XS::decode_json("true");
+    my $json_boolean_class = ref JSON::XS::decode_json("[true]")->[0];
     $expect =~ s{JSON::XS::Boolean}{$json_boolean_class}g;
     same( $dump= $o->Data(\%hash)->Out, template( $expect, expected_dot => $expected_dot ), "", $o);
 }
diff --git a/t/test_helper.pl b/t/test_helper.pl
index 1a5ed61..2519636 100644
--- a/t/test_helper.pl
+++ b/t/test_helper.pl
@@ -110,12 +110,19 @@ sub _same {
     s/\(0x[0-9a-xA-X]+\)/(0xdeadbeef)/g for $str1, $str2;
     my @vars = $str2 =~ m/^(?:my\s*)?(\$\w+)\s*=/gm;
 
+    for ($str1, $str2) {
+        s/^\s+# use warnings;\n//mg;
+        s/^\s+# use strict[^;]*;\n//mg;
+        s/# ;/#/g;
+    }
+
     #warn "@vars";
     unless ( ok( "\n" . $str1 eq "\n" . $str2, $name ) ) {
         if ( $str2 =~ /\S/ ) {
             eval {
                 print string_diff( "\n" . $str2, "\n" . $str1, "Expected", "Result" );
                 print "Got:\n" . $str1 . "\n";
+                1;
               }
               or do {
                 print "Expected:\n$str2\nGot:\n$str1\n";