fix bug in dumping self-referential scalars

p4raw-id: //depot/perl@4832

diff --git a/ext/Data/Dumper/Dumper.pm b/ext/Data/Dumper/Dumper.pm
index a4aa328..e134a21 100644 (file)
--- a/ext/Data/Dumper/Dumper.pm
+++ b/ext/Data/Dumper/Dumper.pm
@@ -230,7 +230,7 @@ sub _dump {
          if ($s->{purity} and $s->{level} > 0) {
            $out = ($realtype eq 'HASH')  ? '{}' :
              ($realtype eq 'ARRAY') ? '[]' :
-               "''" ;
+               'do{my $o}' ;
            push @post, $name . " = " . $s->{seen}{$id}[0];
          }
          else {

diff --git a/ext/Data/Dumper/Dumper.xs b/ext/Data/Dumper/Dumper.xs
index 125375f..6394a63 100644 (file)
--- a/ext/Data/Dumper/Dumper.xs
+++ b/ext/Data/Dumper/Dumper.xs
@@ -202,7 +202,7 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
                        else if (realtype == SVt_PVAV)
                            sv_catpvn(retval, "[]", 2);
                        else
-                           sv_catpvn(retval, "''", 2);
+                           sv_catpvn(retval, "do{my $o}", 9);
                        postentry = newSVpvn(name, namelen);
                        sv_catpvn(postentry, " = ", 3);
                        sv_catsv(postentry, othername);

diff --git a/t/lib/dumper.t b/t/lib/dumper.t
index 0ac2696..3167535 100755 (executable)
--- a/t/lib/dumper.t
+++ b/t/lib/dumper.t
@@ -56,11 +56,11 @@ sub TEST {
 
 if (defined &Data::Dumper::Dumpxs) {
   print "### XS extension loaded, will run XS tests\n";
-  $TMAX = 174; $XS = 1;
+  $TMAX = 186; $XS = 1;
 }
 else {
   print "### XS extensions not loaded, will NOT run XS tests\n";
-  $TMAX = 87; $XS = 0;
+  $TMAX = 93; $XS = 0;
 }
 
 print "1..$TMAX\n";
@@ -301,11 +301,11 @@ EOT
 #           #0
 #           10,
 #           #1
-#           '',
+#           do{my $o},
 #           #2
 #           {
 #             'a' => 1,
-#             'b' => '',
+#             'b' => do{my $o},
 #             'c' => [],
 #             'd' => {}
 #           }
@@ -331,10 +331,10 @@ EOT
 #*::foo = \5;
 #*::foo = [
 #  10,
-#  '',
+#  do{my $o},
 #  {
 #    'a' => 1,
-#    'b' => '',
+#    'b' => do{my $o},
 #    'c' => [],
 #    'd' => {}
 #  }
@@ -364,7 +364,7 @@ EOT
 #*::foo = \@bar;
 #*::foo = {
 #  'a' => 1,
-#  'b' => '',
+#  'b' => do{my $o},
 #  'c' => [],
 #  'd' => {}
 #};
@@ -391,7 +391,7 @@ EOT
 #*::foo = $bar;
 #*::foo = {
 #  'a' => 1,
-#  'b' => '',
+#  'b' => do{my $o},
 #  'c' => [],
 #  'd' => {}
 #};
@@ -640,7 +640,7 @@ TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dumpxs;)
   $WANT = <<'EOT';
 #@a = (
 #  undef,
-#  ''
+#  do{my $o}
 #);
 #$a[1] = \$a[0];
 EOT
@@ -677,7 +677,7 @@ TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
 #  {
 #    a => \[
 #        {
-#          c => ''
+#          c => do{my $o}
 #        },
 #        {
 #          d => \[]
@@ -768,3 +768,34 @@ TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dump;);
 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dumpxs;)
        if $XS;
 }
+
+{
+    $a = \$a;
+    $b = [$a];
+
+############# 175
+##
+  $WANT = <<'EOT';
+#$b = [
+#  \$b->[0]
+#];
+EOT
+
+TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dump;);
+TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dumpxs;)
+       if $XS;
+
+############# 181
+##
+  $WANT = <<'EOT';
+#$b = [
+#  \do{my $o}
+#];
+#${$b->[0]} = $b->[0];
+EOT
+
+
+TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dump;);
+TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dumpxs;)
+       if $XS;
+}