From: Gurusamy Sarathy Date: Sat, 31 Oct 1998 09:31:36 +0000 (+0000) Subject: Data::Dumper update X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7820172aeabcfabb96bd74a4753f9acdd5f3e3da;p=p5sagit%2Fp5-mst-13.2.git Data::Dumper update p4raw-id: //depot/perl@2159 --- diff --git a/ext/Data/Dumper/Changes b/ext/Data/Dumper/Changes index a164958..9a96eda 100644 --- a/ext/Data/Dumper/Changes +++ b/ext/Data/Dumper/Changes @@ -6,6 +6,24 @@ HISTORY - public release history for Data::Dumper =over 8 +=item 2.10 (31 Oct 1998) + +Bugfixes for dumping related undef values, globs, and better double +quoting: three patches suggested by Gisle Aas . + +Escaping of single quotes in the XS version could get tripped up +by the presence of nulls in the string. Fix suggested by +Slaven Rezic . + +Rather large scale reworking of the logic in how seen values +are stashed. Anonymous scalars that may be encountered while +traversing the structure are properly tracked, in case they become +used in data dumped in a later pass. There used to be a problem +with the previous logic that prevented such structures from being +dumped correctly. + +Various additions to the testsuite. + =item 2.09 (9 July 1998) Implement $Data::Dumper::Bless, suggested by Mark Daku . diff --git a/ext/Data/Dumper/Dumper.pm b/ext/Data/Dumper/Dumper.pm index e3c361f..4369664 100644 --- a/ext/Data/Dumper/Dumper.pm +++ b/ext/Data/Dumper/Dumper.pm @@ -9,7 +9,7 @@ package Data::Dumper; -$VERSION = $VERSION = '2.09'; +$VERSION = $VERSION = '2.10'; #$| = 1; @@ -208,8 +208,6 @@ sub _dump { my($sname); my($out, $realpack, $realtype, $type, $ipad, $id, $blesspad); - return "undef" unless defined $val; - $type = ref $val; $out = ""; @@ -218,47 +216,47 @@ sub _dump { # prep it, if it looks like an object if ($type =~ /[a-z_:]/) { my $freezer = $s->{freezer}; - # UNIVERSAL::can should be used here, when we can require 5.004 - if ($freezer) { - eval { $val->$freezer() }; - carp "WARNING(Freezer method call failed): $@" if $@; - } + $val->$freezer() if $freezer && UNIVERSAL::can($val, $freezer); } ($realpack, $realtype, $id) = (overload::StrVal($val) =~ /^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$/); - # keep a tab on it so that we dont fall into recursive pit - if (exists $s->{seen}{$id}) { -# if ($s->{expdepth} < $s->{level}) { - if ($s->{purity} and $s->{level} > 0) { - $out = ($realtype eq 'HASH') ? '{}' : - ($realtype eq 'ARRAY') ? '[]' : - "''" ; - push @post, $name . " = " . $s->{seen}{$id}[0]; - } - else { - $out = $s->{seen}{$id}[0]; - if ($name =~ /^([\@\%])/) { - my $start = $1; - if ($out =~ /^\\$start/) { - $out = substr($out, 1); + # if it has a name, we need to either look it up, or keep a tab + # on it so we know when we hit it later + if (defined($name) and length($name)) { + # keep a tab on it so that we dont fall into recursive pit + if (exists $s->{seen}{$id}) { +# if ($s->{expdepth} < $s->{level}) { + if ($s->{purity} and $s->{level} > 0) { + $out = ($realtype eq 'HASH') ? '{}' : + ($realtype eq 'ARRAY') ? '[]' : + "''" ; + push @post, $name . " = " . $s->{seen}{$id}[0]; } else { - $out = $start . '{' . $out . '}'; - } - } + $out = $s->{seen}{$id}[0]; + if ($name =~ /^([\@\%])/) { + my $start = $1; + if ($out =~ /^\\$start/) { + $out = substr($out, 1); + } + else { + $out = $start . '{' . $out . '}'; + } + } + } + return $out; +# } + } + else { + # store our name + $s->{seen}{$id} = [ (($name =~ /^[@%]/) ? ('\\' . $name ) : + ($realtype eq 'CODE' and + $name =~ /^[*](.*)$/) ? ('\\&' . $1 ) : + $name ), + $val ]; } - return $out; -# } - } - else { - # store our name - $s->{seen}{$id} = [ (($name =~ /^[@%]/) ? ('\\' . $name ) : - ($realtype eq 'CODE' and - $name =~ /^[*](.*)$/) ? ('\\&' . $1 ) : - $name ), - $val ]; } $s->{level}++; @@ -272,14 +270,14 @@ sub _dump { if ($realtype eq 'SCALAR') { if ($realpack) { - $out .= 'do{\\(my $o = ' . $s->_dump($$val, "") . ')}'; + $out .= 'do{\\(my $o = ' . $s->_dump($$val, "\${$name}") . ')}'; } else { - $out .= '\\' . $s->_dump($$val, ""); + $out .= '\\' . $s->_dump($$val, "\${$name}"); } } elsif ($realtype eq 'GLOB') { - $out .= '\\' . $s->_dump($$val, ""); + $out .= '\\' . $s->_dump($$val, "*{$name}"); } elsif ($realtype eq 'ARRAY') { my($v, $pad, $mname); @@ -287,7 +285,9 @@ sub _dump { $out .= ($name =~ /^\@/) ? '(' : '['; $pad = $s->{sep} . $s->{pad} . $s->{apad}; ($name =~ /^\@(.*)$/) ? ($mname = "\$" . $1) : - ($name =~ /[]}]$/) ? ($mname = $name) : ($mname = $name . '->'); + # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar} + ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) : + ($mname = $name . '->'); $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/; for $v (@$val) { $sname = $mname . '[' . $i . ']'; @@ -303,8 +303,10 @@ sub _dump { $out .= ($name =~ /^\%/) ? '(' : '{'; $pad = $s->{sep} . $s->{pad} . $s->{apad}; $lpad = $s->{apad}; - ($name =~ /^\%(.*)$/) ? ($mname = "\$" . $1) : - ($name =~ /[]}]$/) ? ($mname = $name) : ($mname = $name . '->'); + ($name =~ /^\%(.*)$/) ? ($mname = "\$" . $1) : + # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar} + ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) : + ($mname = $name . '->'); $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/; while (($k, $v) = each %$val) { my $nk = $s->_dump($k, ""); @@ -347,11 +349,15 @@ sub _dump { if ($name ne '') { ($id) = ("$ref" =~ /\(([^\(]*)\)$/); if (exists $s->{seen}{$id}) { - $out = $s->{seen}{$id}[0]; - return $out; + if ($s->{seen}{$id}[2]) { + $out = $s->{seen}{$id}[0]; + #warn "[<$out]\n"; + return "\${$out}"; + } } else { - $s->{seen}{$id} = ["\\$name", $val]; + #warn "[>\\$name]\n"; + $s->{seen}{$id} = ["\\$name", $ref]; } } if (ref($ref) eq 'GLOB' or "$ref" =~ /=GLOB\([^()]+\)$/) { # glob @@ -368,21 +374,28 @@ sub _dump { my $k; local ($s->{level}) = 0; for $k (qw(SCALAR ARRAY HASH)) { + my $gval = *$val{$k}; + next unless defined $gval; + next if $k eq "SCALAR" && ! defined $$gval; # always there + # _dump can push into @post, so we hold our place using $postlen my $postlen = scalar @post; $post[$postlen] = "\*$sname = "; local ($s->{apad}) = " " x length($post[$postlen]) if $s->{indent} >= 2; - $post[$postlen] .= $s->_dump(*{$name}{$k}, "\*$sname\{$k\}"); + $post[$postlen] .= $s->_dump($gval, "\*$sname\{$k\}"); } } $out .= '*' . $sname; } + elsif (!defined($val)) { + $out .= "undef"; + } elsif ($val =~ /^-?[1-9]\d{0,8}$/) { # safe decimal number $out .= $val; } else { # string if ($s->{useqq}) { - $out .= qquote($val); + $out .= qquote($val, $s->{useqq}); } else { $val =~ s/([\\\'])/\\$1/g; @@ -390,10 +403,16 @@ sub _dump { } } } - - # if we made it this far, $id was added to seen list at current - # level, so remove it to get deep copies - delete($s->{seen}{$id}) if $id and $s->{deepcopy}; + if ($id) { + # if we made it this far, $id was added to seen list at current + # level, so remove it to get deep copies + if ($s->{deepcopy}) { + delete($s->{seen}{$id}); + } + elsif ($name) { + $s->{seen}{$id}[2] = 1; + } + } return $out; } @@ -493,22 +512,41 @@ sub Bless { defined($v) ? (($s->{'bless'} = $v), return $s) : $s->{'bless'}; } +# used by qquote below +my %esc = ( + "\a" => "\\a", + "\b" => "\\b", + "\t" => "\\t", + "\n" => "\\n", + "\f" => "\\f", + "\r" => "\\r", + "\e" => "\\e", +); + # put a string value in double quotes sub qquote { local($_) = shift; - s/([\\\"\@\$\%])/\\$1/g; - s/\a/\\a/g; - s/[\b]/\\b/g; - s/\t/\\t/g; - s/\n/\\n/g; - s/\f/\\f/g; - s/\r/\\r/g; - s/\e/\\e/g; - -# this won't work! -# s/([^\a\b\t\n\f\r\e\038-\176])/'\\'.sprintf('%03o',ord($1))/eg; - s/([\000-\006\013\016-\032\034-\037\177\200-\377])/'\\'.sprintf('%03o',ord($1))/eg; - return "\"$_\""; + s/([\\\"\@\$])/\\$1/g; + return qq("$_") unless /[^\040-\176]/; # fast exit + + my $high = shift || ""; + s/([\a\b\t\n\f\r\e])/$esc{$1}/g; + + # no need for 3 digits in escape for these + s/([\0-\037])(?!\d)/'\\'.sprintf('%o',ord($1))/eg; + + s/([\0-\037\177])/'\\'.sprintf('%03o',ord($1))/eg; + if ($high eq "iso8859") { + s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg; + } elsif ($high eq "utf8") { +# use utf8; +# $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge; + } elsif ($high eq "8bit") { + # leave it as it is + } else { + s/([\0-\037\177-\377])/'\\'.sprintf('%03o',ord($1))/eg; + } + return qq("$_"); } 1; @@ -954,7 +992,7 @@ modify it under the same terms as Perl itself. =head1 VERSION -Version 2.09 (9 July 1998) +Version 2.10 (31 Oct 1998) =head1 SEE ALSO diff --git a/ext/Data/Dumper/Dumper.xs b/ext/Data/Dumper/Dumper.xs index d8012ee..56f9ac5 100644 --- a/ext/Data/Dumper/Dumper.xs +++ b/ext/Data/Dumper/Dumper.xs @@ -2,8 +2,17 @@ #include "perl.h" #include "XSUB.h" -static SV *freezer; -static SV *toaster; +#if PATCHLEVEL < 5 +# ifndef PL_sv_undef +# define PL_sv_undef sv_undef +# endif +# ifndef ERRSV +# define ERRSV GvSV(errgv) +# endif +# ifndef newSVpvn +# define newSVpvn newSVpv +# endif +#endif static I32 num_q _((char *s, STRLEN slen)); static I32 esc_q _((char *dest, char *src, STRLEN slen)); @@ -84,7 +93,7 @@ static SV * sv_x(SV *sv, register char *str, STRLEN len, I32 n) { if (sv == Nullsv) - sv = newSVpv("", 0); + sv = newSVpvn("", 0); else assert(SvTYPE(sv) >= SVt_PV); @@ -121,11 +130,9 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, U32 i; char *c, *r, *realpack, id[128]; SV **svp; - SV *sv; + SV *sv, *ipad, *ival; SV *blesspad = Nullsv; - SV *ipad; - SV *ival; - AV *seenentry; + AV *seenentry = Nullav; char *iname; STRLEN inamelen, idlen = 0; U32 flags; @@ -139,10 +146,6 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, if (SvGMAGICAL(val)) mg_get(val); - if (val == &PL_sv_undef || !SvOK(val)) { - sv_catpvn(retval, "undef", 5); - return 1; - } if (SvROK(val)) { if (SvOBJECT(SvRV(val)) && freezer && @@ -152,9 +155,9 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, XPUSHs(val); PUTBACK; i = perl_call_method(SvPVX(freezer), G_EVAL|G_SCALAR); SPAGAIN; - if (SvTRUE(GvSV(PL_errgv))) + if (SvTRUE(ERRSV)) warn("WARNING(Freezer method call failed): %s", - SvPVX(GvSV(PL_errgv))); + SvPVX(ERRSV)); else if (i) val = newSVsv(POPs); PUTBACK; FREETMPS; LEAVE; @@ -171,67 +174,77 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, realpack = HvNAME(SvSTASH(ival)); else realpack = Nullch; - if ((svp = hv_fetch(seenhv, id, idlen, FALSE)) && - (sv = *svp) && SvROK(sv) && - (seenentry = (AV*)SvRV(sv))) { - SV *othername; - if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp)) { - if (purity && *levelp > 0) { - SV *postentry; - - if (realtype == SVt_PVHV) - sv_catpvn(retval, "{}", 2); - else if (realtype == SVt_PVAV) - sv_catpvn(retval, "[]", 2); - else - sv_catpvn(retval, "''", 2); - postentry = newSVpv(name, namelen); - sv_catpvn(postentry, " = ", 3); - sv_catsv(postentry, othername); - av_push(postav, postentry); - } - else { - if (name[0] == '@' || name[0] == '%') { - if ((SvPVX(othername))[0] == '\\' && - (SvPVX(othername))[1] == name[0]) { - sv_catpvn(retval, SvPVX(othername)+1, SvCUR(othername)-1); + + /* if it has a name, we need to either look it up, or keep a tab + * on it so we know when we hit it later + */ + if (namelen) { + if ((svp = hv_fetch(seenhv, id, idlen, FALSE)) + && (sv = *svp) && SvROK(sv) && (seenentry = (AV*)SvRV(sv))) + { + SV *othername; + if ((svp = av_fetch(seenentry, 0, FALSE)) + && (othername = *svp)) + { + if (purity && *levelp > 0) { + SV *postentry; + + if (realtype == SVt_PVHV) + sv_catpvn(retval, "{}", 2); + else if (realtype == SVt_PVAV) + sv_catpvn(retval, "[]", 2); + else + sv_catpvn(retval, "''", 2); + postentry = newSVpvn(name, namelen); + sv_catpvn(postentry, " = ", 3); + sv_catsv(postentry, othername); + av_push(postav, postentry); + } + else { + if (name[0] == '@' || name[0] == '%') { + if ((SvPVX(othername))[0] == '\\' && + (SvPVX(othername))[1] == name[0]) { + sv_catpvn(retval, SvPVX(othername)+1, + SvCUR(othername)-1); + } + else { + sv_catpvn(retval, name, 1); + sv_catpvn(retval, "{", 1); + sv_catsv(retval, othername); + sv_catpvn(retval, "}", 1); + } } - else { - sv_catpvn(retval, name, 1); - sv_catpvn(retval, "{", 1); + else sv_catsv(retval, othername); - sv_catpvn(retval, "}", 1); - } } - else - sv_catsv(retval, othername); + return 1; + } + else { + warn("ref name not found for %s", id); + return 0; } - return 1; - } - else { - warn("ref name not found for %s", id); - return 0; - } - } - else { /* store our name and continue */ - SV *namesv; - if (name[0] == '@' || name[0] == '%') { - namesv = newSVpv("\\", 1); - sv_catpvn(namesv, name, namelen); } - else if (realtype == SVt_PVCV && name[0] == '*') { - namesv = newSVpv("\\", 2); - sv_catpvn(namesv, name, namelen); - (SvPVX(namesv))[1] = '&'; + else { /* store our name and continue */ + SV *namesv; + if (name[0] == '@' || name[0] == '%') { + namesv = newSVpvn("\\", 1); + sv_catpvn(namesv, name, namelen); + } + else if (realtype == SVt_PVCV && name[0] == '*') { + namesv = newSVpvn("\\", 2); + sv_catpvn(namesv, name, namelen); + (SvPVX(namesv))[1] = '&'; + } + else + namesv = newSVpvn(name, namelen); + seenentry = newAV(); + av_push(seenentry, namesv); + (void)SvREFCNT_inc(val); + av_push(seenentry, val); + (void)hv_store(seenhv, id, strlen(id), + newRV((SV*)seenentry), 0); + SvREFCNT_dec(seenentry); } - else - namesv = newSVpv(name, namelen); - seenentry = newAV(); - av_push(seenentry, namesv); - (void)SvREFCNT_inc(val); - av_push(seenentry, val); - (void)hv_store(seenhv, id, strlen(id), newRV((SV*)seenentry), 0); - SvREFCNT_dec(seenentry); } (*levelp)++; @@ -249,20 +262,34 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, } } - if (realtype <= SVt_PVBM || realtype == SVt_PVGV) { /* scalars */ - if (realpack && realtype != SVt_PVGV) { /* blessed */ + if (realtype <= SVt_PVBM) { /* scalar ref */ + SV *namesv = newSVpvn("${", 2); + sv_catpvn(namesv, name, namelen); + sv_catpvn(namesv, "}", 1); + if (realpack) { /* blessed */ sv_catpvn(retval, "do{\\(my $o = ", 13); - DD_dump(ival, "", 0, retval, seenhv, postav, - levelp, indent, pad, xpad, apad, sep, + DD_dump(ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv, + postav, levelp, indent, pad, xpad, apad, sep, freezer, toaster, purity, deepcopy, quotekeys, bless); sv_catpvn(retval, ")}", 2); - } + } /* plain */ else { sv_catpvn(retval, "\\", 1); - DD_dump(ival, "", 0, retval, seenhv, postav, - levelp, indent, pad, xpad, apad, sep, + DD_dump(ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv, + postav, levelp, indent, pad, xpad, apad, sep, freezer, toaster, purity, deepcopy, quotekeys, bless); } + SvREFCNT_dec(namesv); + } + else if (realtype == SVt_PVGV) { /* glob ref */ + SV *namesv = newSVpvn("*{", 2); + sv_catpvn(namesv, name, namelen); + sv_catpvn(namesv, "}", 1); + sv_catpvn(retval, "\\", 1); + DD_dump(ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv, + postav, levelp, indent, pad, xpad, apad, sep, + freezer, toaster, purity, deepcopy, quotekeys, bless); + SvREFCNT_dec(namesv); } else if (realtype == SVt_PVAV) { SV *totpad; @@ -280,7 +307,16 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, } else { sv_catpvn(retval, "[", 1); - if (namelen > 0 && name[namelen-1] != ']' && name[namelen-1] != '}') { + /* omit "->" in $foo{bar}->[0], but not in ${$foo}->[0] */ + /*if (namelen > 0 + && name[namelen-1] != ']' && name[namelen-1] != '}' + && (namelen < 4 || (name[1] != '{' && name[2] != '{')))*/ + if ((namelen > 0 + && name[namelen-1] != ']' && name[namelen-1] != '}') + || (namelen > 4 + && (name[1] == '{' + || (name[0] == '\\' && name[2] == '{')))) + { iname[inamelen++] = '-'; iname[inamelen++] = '>'; iname[inamelen] = '\0'; } @@ -346,14 +382,20 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, I32 klen; SV *hval; - iname = newSVpv(name, namelen); + iname = newSVpvn(name, namelen); if (name[0] == '%') { sv_catpvn(retval, "(", 1); (SvPVX(iname))[0] = '$'; } else { sv_catpvn(retval, "{", 1); - if (namelen > 0 && name[namelen-1] != ']' && name[namelen-1] != '}') { + /* omit "->" in $foo[0]->{bar}, but not in ${$foo}->{bar} */ + if ((namelen > 0 + && name[namelen-1] != ']' && name[namelen-1] != '}') + || (namelen > 4 + && (name[1] == '{' + || (name[0] == '\\' && name[2] == '{')))) + { sv_catpvn(iname, "->", 2); } } @@ -472,33 +514,36 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, (void) sprintf(id, "0x%lx", (unsigned long)val); if ((svp = hv_fetch(seenhv, id, (idlen = strlen(id)), FALSE)) && (sv = *svp) && SvROK(sv) && - (seenentry = (AV*)SvRV(sv))) { + (seenentry = (AV*)SvRV(sv))) + { SV *othername; - if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp)) { + if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp) + && (svp = av_fetch(seenentry, 2, FALSE)) && *svp && SvIV(*svp) > 0) + { + sv_catpvn(retval, "${", 2); sv_catsv(retval, othername); + sv_catpvn(retval, "}", 1); return 1; } } else { SV *namesv; - namesv = newSVpv("\\", 1); + namesv = newSVpvn("\\", 1); sv_catpvn(namesv, name, namelen); seenentry = newAV(); av_push(seenentry, namesv); - (void)SvREFCNT_inc(val); - av_push(seenentry, val); + av_push(seenentry, newRV(val)); (void)hv_store(seenhv, id, strlen(id), newRV((SV*)seenentry), 0); SvREFCNT_dec(seenentry); } } - + if (SvIOK(val)) { STRLEN len; i = SvIV(val); (void) sprintf(tmpbuf, "%d", i); len = strlen(tmpbuf); sv_catpvn(retval, tmpbuf, len); - return 1; } else if (realtype == SVt_PVGV) {/* GLOBs can end up with scribbly names */ c = SvPV(val, i); @@ -522,21 +567,27 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, r[0] = '*'; strcpy(r+1, c); i++; } + SvCUR_set(retval, SvCUR(retval)+i); if (purity) { static char *entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" }; static STRLEN sizes[] = { 8, 7, 6 }; SV *e; - SV *nname = newSVpv("", 0); - SV *newapad = newSVpv("", 0); + SV *nname = newSVpvn("", 0); + SV *newapad = newSVpvn("", 0); GV *gv = (GV*)val; I32 j; for (j=0; j<3; j++) { e = ((j == 0) ? GvSV(gv) : (j == 1) ? (SV*)GvAV(gv) : (SV*)GvHV(gv)); - if (e) { + if (!e) + continue; + if (j == 0 && !SvOK(e)) + continue; + + { I32 nlevel = 0; - SV *postentry = newSVpv(r,i); + SV *postentry = newSVpvn(r,i); sv_setsv(nname, postentry); sv_catpvn(nname, entries[j], sizes[j]); @@ -560,6 +611,9 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, SvREFCNT_dec(nname); } } + else if (val == &PL_sv_undef || !SvOK(val)) { + sv_catpvn(retval, "undef", 5); + } else { c = SvPV(val, i); sv_grow(retval, SvCUR(retval)+3+2*i); @@ -569,13 +623,18 @@ DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, ++i; r[i++] = '\''; r[i] = '\0'; + SvCUR_set(retval, SvCUR(retval)+i); } - SvCUR_set(retval, SvCUR(retval)+i); } - if (deepcopy && idlen) - (void)hv_delete(seenhv, id, idlen, G_DISCARD); - + if (idlen) { + if (deepcopy) + (void)hv_delete(seenhv, id, idlen, G_DISCARD); + else if (namelen && seenentry) { + SV *mark = *av_fetch(seenentry, 2, TRUE); + sv_setiv(mark,1); + } + } return 1; } @@ -647,7 +706,7 @@ Data_Dumper_Dumpxs(href, ...) terse = useqq = purity = deepcopy = 0; quotekeys = 1; - retval = newSVpv("", 0); + retval = newSVpvn("", 0); if (SvROK(href) && (hv = (HV*)SvRV((SV*)href)) && SvTYPE(hv) == SVt_PVHV) { @@ -692,7 +751,7 @@ Data_Dumper_Dumpxs(href, ...) imax = av_len(todumpav); else imax = -1; - valstr = newSVpv("",0); + valstr = newSVpvn("",0); for (i = 0; i <= imax; ++i) { SV *newapad; @@ -787,7 +846,7 @@ Data_Dumper_Dumpxs(href, ...) if (gimme == G_ARRAY) { XPUSHs(sv_2mortal(retval)); if (i < imax) /* not the last time thro ? */ - retval = newSVpv("",0); + retval = newSVpvn("",0); } } SvREFCNT_dec(postav); diff --git a/ext/Data/Dumper/Todo b/ext/Data/Dumper/Todo index 4a41f97..7dcd40b 100644 --- a/ext/Data/Dumper/Todo +++ b/ext/Data/Dumper/Todo @@ -29,4 +29,6 @@ where we don't care so much for cross-references). =item Implement redesign that allows various backends (Perl, Lisp, some-binary-data-format, graph-description-languages, etc.) +=item Dump traversal in breadth-first order + =back