From: Gurusamy Sarathy Date: Fri, 21 Jan 2000 16:49:09 +0000 (+0000) Subject: fix bug in dumping self-referential scalars X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5df59fb6a00631e53c12c105628822fb0f102119;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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; +}