Data::Dumper update

p4raw-id: //depot/perl@2159

4 files changed, 278 insertions, 161 deletions

diff --git a/ext/Data/Dumper/Changes b/ext/Data/Dumper/Changes
index a1649583f2..9a96edab8d 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 <gisle@aas.no>.
+
+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 <eserte@cs.tu-berlin.de>.
+
+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 <daku@nortel.ca>.
diff --git a/ext/Data/Dumper/Dumper.pm b/ext/Data/Dumper/Dumper.pm
index e3c361f3a2..4369664a5a 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 d8012eec5b..56f9ac5bd5 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 4a41f97d7f..7dcd40b8e3 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