Fix a possibly infinite recursion in Perl Data::Dumper.

Derived from Perl git commit http://perl5.git.perl.org/perl.git
19be3be6968e2337bcdfe480693fff795ecd1304
Add a configuration variable/option to limit recursion when dumping
deep data structures.
Defaults the limit to 1000, which can be reduced or increase, or
eliminated by setting it to 0.
This patch addresses CVE-2014-4330.  This bug was found and
reported by: LSE Leading Security Experts GmbH employee Markus
Vervier.

From Maximilian Pascher;  OK schwarze@ afresh1@

5 files changed, 594 insertions, 303 deletions

diff --git a/gnu/usr.bin/perl/MANIFEST b/gnu/usr.bin/perl/MANIFEST
index 72bfe81065e..92fbaa43ad4 100644
--- a/gnu/usr.bin/perl/MANIFEST
+++ b/gnu/usr.bin/perl/MANIFEST
@@ -3155,6 +3155,7 @@ dist/Data-Dumper/t/perl-74170.t	Regression test for stack reallocation
 dist/Data-Dumper/t/purity_deepcopy_maxdepth.t	See if three Data::Dumper functions work
 dist/Data-Dumper/t/qr.t		See if Data::Dumper works with qr|/|
 dist/Data-Dumper/t/quotekeys.t	See if Data::Dumper::Quotekeys works
+dist/Data-Dumper/t/recurse.t	See if Data::Dumper::Maxrecurse works
 dist/Data-Dumper/t/seen.t	See if Data::Dumper::Seen works
 dist/Data-Dumper/t/sortkeys.t	See if Data::Dumper::Sortkeys works
 dist/Data-Dumper/t/sparseseen.t	See if Data::Dumper::Sparseseen works
diff --git a/gnu/usr.bin/perl/dist/Data-Dumper/Dumper.pm b/gnu/usr.bin/perl/dist/Data-Dumper/Dumper.pm
index 0eb8bf74fd6..8c7c94b3ea7 100644
--- a/gnu/usr.bin/perl/dist/Data-Dumper/Dumper.pm
+++ b/gnu/usr.bin/perl/dist/Data-Dumper/Dumper.pm
@@ -9,7 +9,9 @@
 
 package Data::Dumper;
 
-$VERSION = '2.125'; # Don't forget to set version and release date in POD!
+BEGIN {
+    $VERSION = '2.145'; # Don't forget to set version and release
+}               # date in POD below!
 
 #$| = 1;
 
@@ -28,13 +30,13 @@ BEGIN {
     # XSLoader should be attempted to load, or the pure perl flag
     # toggled on load failure.
     eval {
-	require XSLoader;
-    };
-    $Useperl = 1 if $@;
+        require XSLoader;
+        XSLoader::load( 'Data::Dumper' );
+        1
+    }
+    or $Useperl = 1;
 }
 
-XSLoader::load( 'Data::Dumper' ) unless $Useperl;
-
 # module vars and their defaults
 $Indent     = 2         unless defined $Indent;
 $Purity     = 0         unless defined $Purity;
@@ -53,6 +55,8 @@ $Pair       = ' => '    unless defined $Pair;
 $Useperl    = 0         unless defined $Useperl;
 $Sortkeys   = 0         unless defined $Sortkeys;
 $Deparse    = 0         unless defined $Deparse;
+$Sparseseen = 0         unless defined $Sparseseen;
+$Maxrecurse = 1000      unless defined $Maxrecurse;
 
 #
 # expects an arrayref of values to be dumped.
@@ -63,36 +67,38 @@ $Deparse    = 0         unless defined $Deparse;
 sub new {
   my($c, $v, $n) = @_;
 
-  croak "Usage:  PACKAGE->new(ARRAYREF, [ARRAYREF])" 
+  croak "Usage:  PACKAGE->new(ARRAYREF, [ARRAYREF])"
     unless (defined($v) && (ref($v) eq 'ARRAY'));
   $n = [] unless (defined($n) && (ref($n) eq 'ARRAY'));
 
-  my($s) = { 
-             level      => 0,           # current recursive depth
-	     indent     => $Indent,     # various styles of indenting
-	     pad	=> $Pad,        # all lines prefixed by this string
-	     xpad       => "",          # padding-per-level
-	     apad       => "",          # added padding for hash keys n such
-	     sep        => "",          # list separator
-	     pair	=> $Pair,	# hash key/value separator: defaults to ' => '
-	     seen       => {},          # local (nested) refs (id => [name, val])
-	     todump     => $v,          # values to dump []
-	     names      => $n,          # optional names for values []
-	     varname    => $Varname,    # prefix to use for tagging nameless ones
-             purity     => $Purity,     # degree to which output is evalable
-             useqq 	=> $Useqq,      # use "" for strings (backslashitis ensues)
-             terse 	=> $Terse,      # avoid name output (where feasible)
-             freezer	=> $Freezer,    # name of Freezer method for objects
-             toaster	=> $Toaster,    # name of method to revive objects
-             deepcopy	=> $Deepcopy,   # dont cross-ref, except to stop recursion
-             quotekeys	=> $Quotekeys,  # quote hash keys
-             'bless'	=> $Bless,	# keyword to use for "bless"
-#	     expdepth   => $Expdepth,   # cutoff depth for explicit dumping
-	     maxdepth	=> $Maxdepth,   # depth beyond which we give up
-	     useperl    => $Useperl,    # use the pure Perl implementation
-	     sortkeys   => $Sortkeys,   # flag or filter for sorting hash keys
-	     deparse	=> $Deparse,	# use B::Deparse for coderefs
-	   };
+  my($s) = {
+        level      => 0,           # current recursive depth
+        indent     => $Indent,     # various styles of indenting
+        pad        => $Pad,        # all lines prefixed by this string
+        xpad       => "",          # padding-per-level
+        apad       => "",          # added padding for hash keys n such
+        sep        => "",          # list separator
+        pair       => $Pair,    # hash key/value separator: defaults to ' => '
+        seen       => {},          # local (nested) refs (id => [name, val])
+        todump     => $v,          # values to dump []
+        names      => $n,          # optional names for values []
+        varname    => $Varname,    # prefix to use for tagging nameless ones
+        purity     => $Purity,     # degree to which output is evalable
+        useqq      => $Useqq,      # use "" for strings (backslashitis ensues)
+        terse      => $Terse,      # avoid name output (where feasible)
+        freezer    => $Freezer,    # name of Freezer method for objects
+        toaster    => $Toaster,    # name of method to revive objects
+        deepcopy   => $Deepcopy,   # dont cross-ref, except to stop recursion
+        quotekeys  => $Quotekeys,  # quote hash keys
+        'bless'    => $Bless,    # keyword to use for "bless"
+#        expdepth   => $Expdepth,   # cutoff depth for explicit dumping
+        maxdepth   => $Maxdepth,   # depth beyond which we give up
+	maxrecurse => $Maxrecurse, # depth beyond which we abort
+        useperl    => $Useperl,    # use the pure Perl implementation
+        sortkeys   => $Sortkeys,   # flag or filter for sorting hash keys
+        deparse    => $Deparse,    # use B::Deparse for coderefs
+        noseen     => $Sparseseen, # do not populate the seen hash unless necessary
+       };
 
   if ($Indent > 0) {
     $s->{xpad} = "  ";
@@ -101,26 +107,39 @@ sub new {
   return bless($s, $c);
 }
 
-if ($] >= 5.008) {
-  # Packed numeric addresses take less memory. Plus pack is faster than sprintf
-  *init_refaddr_format = sub {};
+# Packed numeric addresses take less memory. Plus pack is faster than sprintf
+
+# Most users of current versions of Data::Dumper will be 5.008 or later.
+# Anyone on 5.6.1 and 5.6.2 upgrading will be rare (particularly judging by
+# the bug reports from users on those platforms), so for the common case avoid
+# complexity, and avoid even compiling the unneeded code.
 
-  *format_refaddr  = sub {
+sub init_refaddr_format {
+}
+
+sub format_refaddr {
     require Scalar::Util;
     pack "J", Scalar::Util::refaddr(shift);
-  };
-} else {
-  *init_refaddr_format = sub {
-    require Config;
-    my $f = $Config::Config{uvxformat};
-    $f =~ tr/"//d;
-    our $refaddr_format = "0x%" . $f;
-  };
-
-  *format_refaddr = sub {
-    require Scalar::Util;
-    sprintf our $refaddr_format, Scalar::Util::refaddr(shift);
-  }
+};
+
+if ($] < 5.008) {
+    eval <<'EOC' or die;
+    no warnings 'redefine';
+    my $refaddr_format;
+    sub init_refaddr_format {
+        require Config;
+        my $f = $Config::Config{uvxformat};
+        $f =~ tr/"//d;
+        $refaddr_format = "0x%" . $f;
+    }
+
+    sub format_refaddr {
+        require Scalar::Util;
+        sprintf $refaddr_format, Scalar::Util::refaddr(shift);
+    }
+
+    1
+EOC
 }
 
 #
@@ -132,21 +151,26 @@ sub Seen {
     init_refaddr_format();
     my($k, $v, $id);
     while (($k, $v) = each %$g) {
-      if (defined $v and ref $v) {
-	$id = format_refaddr($v);
-	if ($k =~ /^[*](.*)$/) {
-	  $k = (ref $v eq 'ARRAY') ? ( "\\\@" . $1 ) :
-	       (ref $v eq 'HASH')  ? ( "\\\%" . $1 ) :
-	       (ref $v eq 'CODE')  ? ( "\\\&" . $1 ) :
-				     (   "\$" . $1 ) ;
-	}
-	elsif ($k !~ /^\$/) {
-	  $k = "\$" . $k;
-	}
-	$s->{seen}{$id} = [$k, $v];
+      if (defined $v) {
+        if (ref $v) {
+          $id = format_refaddr($v);
+          if ($k =~ /^[*](.*)$/) {
+            $k = (ref $v eq 'ARRAY') ? ( "\\\@" . $1 ) :
+                 (ref $v eq 'HASH')  ? ( "\\\%" . $1 ) :
+                 (ref $v eq 'CODE')  ? ( "\\\&" . $1 ) :
+                 (   "\$" . $1 ) ;
+          }
+          elsif ($k !~ /^\$/) {
+            $k = "\$" . $k;
+          }
+          $s->{seen}{$id} = [$k, $v];
+        }
+        else {
+          carp "Only refs supported, ignoring non-ref item \$$k";
+        }
       }
       else {
-	carp "Only refs supported, ignoring non-ref item \$$k";
+        carp "Value of ref must be defined; ignoring undefined item \$$k";
       }
     }
     return $s;
@@ -161,9 +185,14 @@ sub Seen {
 #
 sub Values {
   my($s, $v) = @_;
-  if (defined($v) && (ref($v) eq 'ARRAY'))  {
-    $s->{todump} = [@$v];        # make a copy
-    return $s;
+  if (defined($v)) {
+    if (ref($v) eq 'ARRAY')  {
+      $s->{todump} = [@$v];        # make a copy
+      return $s;
+    }
+    else {
+      croak "Argument to Values, if provided, must be array ref";
+    }
   }
   else {
     return @{$s->{todump}};
@@ -175,9 +204,14 @@ sub Values {
 #
 sub Names {
   my($s, $n) = @_;
-  if (defined($n) && (ref($n) eq 'ARRAY'))  {
-    $s->{names} = [@$n];         # make a copy
-    return $s;
+  if (defined($n)) {
+    if (ref($n) eq 'ARRAY') {
+      $s->{names} = [@$n];         # make a copy
+      return $s;
+    }
+    else {
+      croak "Argument to Names, if provided, must be array ref";
+    }
   }
   else {
     return @{$s->{names}};
@@ -188,9 +222,9 @@ sub DESTROY {}
 
 sub Dump {
     return &Dumpxs
-	unless $Data::Dumper::Useperl || (ref($_[0]) && $_[0]->{useperl}) ||
-	       $Data::Dumper::Useqq   || (ref($_[0]) && $_[0]->{useqq}) ||
-	       $Data::Dumper::Deparse || (ref($_[0]) && $_[0]->{deparse});
+    unless $Data::Dumper::Useperl || (ref($_[0]) && $_[0]->{useperl}) ||
+           $Data::Dumper::Useqq   || (ref($_[0]) && $_[0]->{useqq}) ||
+           $Data::Dumper::Deparse || (ref($_[0]) && $_[0]->{deparse});
     return &Dumpperl;
 }
 
@@ -208,40 +242,19 @@ sub Dumpperl {
   $s = $s->new(@_) unless ref $s;
 
   for $val (@{$s->{todump}}) {
-    my $out = "";
     @post = ();
     $name = $s->{names}[$i++];
-    if (defined $name) {
-      if ($name =~ /^[*](.*)$/) {
-	if (defined $val) {
-	  $name = (ref $val eq 'ARRAY') ? ( "\@" . $1 ) :
-		  (ref $val eq 'HASH')  ? ( "\%" . $1 ) :
-		  (ref $val eq 'CODE')  ? ( "\*" . $1 ) :
-					  ( "\$" . $1 ) ;
-	}
-	else {
-	  $name = "\$" . $1;
-	}
-      }
-      elsif ($name !~ /^\$/) {
-	$name = "\$" . $name;
-      }
-    }
-    else {
-      $name = "\$" . $s->{varname} . $i;
-    }
+    $name = $s->_refine_name($name, $val, $i);
 
     my $valstr;
     {
       local($s->{apad}) = $s->{apad};
-      $s->{apad} .= ' ' x (length($name) + 3) if $s->{indent} >= 2;
+      $s->{apad} .= ' ' x (length($name) + 3) if $s->{indent} >= 2 and !$s->{terse};
       $valstr = $s->_dump($val, $name);
     }
 
     $valstr = "$name = " . $valstr . ';' if @post or !$s->{terse};
-    $out .= $s->{pad} . $valstr . $s->{sep};
-    $out .= $s->{pad} . join(';' . $s->{sep} . $s->{pad}, @post) 
-      . ';' . $s->{sep} if @post;
+    my $out = $s->_compose_out($valstr, \@post);
 
     push @out, $out;
   }
@@ -255,6 +268,10 @@ sub _quote {
     return  "'" . $val .  "'";
 }
 
+# Old Perls (5.14-) have trouble resetting vstring magic when it is no
+# longer valid.
+use constant _bad_vsmg => defined &_vstring && (_vstring(~v0)||'') eq "v0";
+
 #
 # twist, toil and turn;
 # and recurse, of course.
@@ -263,8 +280,7 @@ sub _quote {
 #
 sub _dump {
   my($s, $val, $name) = @_;
-  my($sname);
-  my($out, $realpack, $realtype, $type, $ipad, $id, $blesspad);
+  my($out, $type, $id, $sname);
 
   $type = ref $val;
   $out = "";
@@ -281,65 +297,70 @@ sub _dump {
     }
 
     require Scalar::Util;
-    $realpack = Scalar::Util::blessed($val);
-    $realtype = $realpack ? Scalar::Util::reftype($val) : ref $val;
+    my $realpack = Scalar::Util::blessed($val);
+    my $realtype = $realpack ? Scalar::Util::reftype($val) : ref $val;
     $id = format_refaddr($val);
 
-    # 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') ? '[]' :
-		'do{my $o}' ;
-	    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);
-	      }
-	      else {
-		$out = $start . '{' . $out . '}';
-	      }
-	    }
-          }
-	  return $out;
-#        }
+    # Note: By this point $name is always defined and of non-zero length.
+    # Keep a tab on it so that we dont fall into recursive pit.
+    if (exists $s->{seen}{$id}) {
+      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 {
-        # store our name
-        $s->{seen}{$id} = [ (($name =~ /^[@%]/)     ? ('\\' . $name ) :
-			     ($realtype eq 'CODE' and
-			      $name =~ /^[*](.*)$/) ? ('\\&' . $1 )   :
-			     $name          ),
-			    $val ];
+        $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 ];
     }
-    my $no_bless = 0; 
+    my $no_bless = 0;
     my $is_regex = 0;
     if ( $realpack and ($] >= 5.009005 ? re::is_regexp($val) : $realpack eq 'Regexp') ) {
         $is_regex = 1;
         $no_bless = $realpack eq 'Regexp';
     }
 
-    # If purity is not set and maxdepth is set, then check depth: 
+    # If purity is not set and maxdepth is set, then check depth:
     # if we have reached maximum depth, return the string
     # representation of the thing we are currently examining
-    # at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)'). 
+    # at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)').
     if (!$s->{purity}
-	and $s->{maxdepth} > 0
-	and $s->{level} >= $s->{maxdepth})
+      and defined($s->{maxdepth})
+      and $s->{maxdepth} > 0
+      and $s->{level} >= $s->{maxdepth})
     {
       return qq['$val'];
     }
 
+    # avoid recursing infinitely [perl #122111]
+    if ($s->{maxrecurse} > 0
+        and $s->{level} >= $s->{maxrecurse}) {
+        die "Recursion limit of $s->{maxrecurse} exceeded";
+    }
+
     # we have a blessed ref
+    my ($blesspad);
     if ($realpack and !$no_bless) {
       $out = $s->{'bless'} . '( ';
       $blesspad = $s->{apad};
@@ -347,13 +368,13 @@ sub _dump {
     }
 
     $s->{level}++;
-    $ipad = $s->{xpad} x $s->{level};
+    my $ipad = $s->{xpad} x $s->{level};
 
     if ($is_regex) {
         my $pat;
-        # This really sucks, re:regexp_pattern is in ext/re/re.xs and not in 
+        # This really sucks, re:regexp_pattern is in ext/re/re.xs and not in
         # universal.c, and even worse we cant just require that re to be loaded
-        # we *have* to use() it. 
+        # we *have* to use() it.
         # We should probably move it to universal.c for 5.10.1 and fix this.
         # Currently we only use re::regexp_pattern when the re is blessed into another
         # package. This has the disadvantage of meaning that a DD dump won't round trip
@@ -363,170 +384,194 @@ sub _dump {
         # But since this means loading the full debugging engine in process we wont
         # bother unless its necessary for accuracy.
         if (($realpack ne 'Regexp') && defined(*re::regexp_pattern{CODE})) {
-            $pat = re::regexp_pattern($val);
-        } else {
-            $pat = "$val";
+          $pat = re::regexp_pattern($val);
         }
-        $pat =~ s,/,\\/,g;
+        else {
+          $pat = "$val";
+        }
+        $pat =~ s <(\\.)|/> { $1 || '\\/' }ge;
         $out .= "qr/$pat/";
     }
-    elsif ($realtype eq 'SCALAR' || $realtype eq 'REF') {
+    elsif ($realtype eq 'SCALAR' || $realtype eq 'REF'
+    || $realtype eq 'VSTRING') {
       if ($realpack) {
-	$out .= 'do{\\(my $o = ' . $s->_dump($$val, "\${$name}") . ')}';
+        $out .= 'do{\\(my $o = ' . $s->_dump($$val, "\${$name}") . ')}';
       }
       else {
-	$out .= '\\' . $s->_dump($$val, "\${$name}");
+        $out .= '\\' . $s->_dump($$val, "\${$name}");
       }
     }
     elsif ($realtype eq 'GLOB') {
-	$out .= '\\' . $s->_dump($$val, "*{$name}");
+      $out .= '\\' . $s->_dump($$val, "*{$name}");
     }
     elsif ($realtype eq 'ARRAY') {
       my($pad, $mname);
       my($i) = 0;
       $out .= ($name =~ /^\@/) ? '(' : '[';
       $pad = $s->{sep} . $s->{pad} . $s->{apad};
-      ($name =~ /^\@(.*)$/) ? ($mname = "\$" . $1) : 
-	# omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar}
-	($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]+\}$/;
       for my $v (@$val) {
-	$sname = $mname . '[' . $i . ']';
-	$out .= $pad . $ipad . '#' . $i if $s->{indent} >= 3;
-	$out .= $pad . $ipad . $s->_dump($v, $sname);
-	$out .= "," if $i++ < $#$val;
+        $sname = $mname . '[' . $i . ']';
+        $out .= $pad . $ipad . '#' . $i
+          if $s->{indent} >= 3;
+        $out .= $pad . $ipad . $s->_dump($v, $sname);
+        $out .= "," if $i++ < $#$val;
       }
       $out .= $pad . ($s->{xpad} x ($s->{level} - 1)) if $i;
       $out .= ($name =~ /^\@/) ? ')' : ']';
     }
     elsif ($realtype eq 'HASH') {
-      my($k, $v, $pad, $lpad, $mname, $pair);
+      my ($k, $v, $pad, $lpad, $mname, $pair);
       $out .= ($name =~ /^\%/) ? '(' : '{';
       $pad = $s->{sep} . $s->{pad} . $s->{apad};
       $lpad = $s->{apad};
       $pair = $s->{pair};
       ($name =~ /^\%(.*)$/) ? ($mname = "\$" . $1) :
-	# omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar}
-	($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]+\}$/;
-      my ($sortkeys, $keys, $key) = ("$s->{sortkeys}");
+      my $sortkeys = defined($s->{sortkeys}) ? $s->{sortkeys} : '';
+      my $keys = [];
       if ($sortkeys) {
-	if (ref($s->{sortkeys}) eq 'CODE') {
-	  $keys = $s->{sortkeys}($val);
-	  unless (ref($keys) eq 'ARRAY') {
-	    carp "Sortkeys subroutine did not return ARRAYREF";
-	    $keys = [];
-	  }
-	}
-	else {
-	  $keys = [ sort keys %$val ];
-	}
+        if (ref($s->{sortkeys}) eq 'CODE') {
+          $keys = $s->{sortkeys}($val);
+          unless (ref($keys) eq 'ARRAY') {
+            carp "Sortkeys subroutine did not return ARRAYREF";
+            $keys = [];
+          }
+        }
+        else {
+          $keys = [ sort keys %$val ];
+        }
       }
 
       # Ensure hash iterator is reset
       keys(%$val);
 
+      my $key;
       while (($k, $v) = ! $sortkeys ? (each %$val) :
-	     @$keys ? ($key = shift(@$keys), $val->{$key}) :
-	     () ) 
+         @$keys ? ($key = shift(@$keys), $val->{$key}) :
+         () )
       {
-	my $nk = $s->_dump($k, "");
-	$nk = $1 if !$s->{quotekeys} and $nk =~ /^[\"\']([A-Za-z_]\w*)[\"\']$/;
-	$sname = $mname . '{' . $nk . '}';
-	$out .= $pad . $ipad . $nk . $pair;
-
-	# temporarily alter apad
-	$s->{apad} .= (" " x (length($nk) + 4)) if $s->{indent} >= 2;
-	$out .= $s->_dump($val->{$k}, $sname) . ",";
-	$s->{apad} = $lpad if $s->{indent} >= 2;
+        my $nk = $s->_dump($k, "");
+        $nk = $1
+          if !$s->{quotekeys} and $nk =~ /^[\"\']([A-Za-z_]\w*)[\"\']$/;
+        $sname = $mname . '{' . $nk . '}';
+        $out .= $pad . $ipad . $nk . $pair;
+
+        # temporarily alter apad
+        $s->{apad} .= (" " x (length($nk) + 4))
+          if $s->{indent} >= 2;
+        $out .= $s->_dump($val->{$k}, $sname) . ",";
+        $s->{apad} = $lpad
+          if $s->{indent} >= 2;
       }
       if (substr($out, -1) eq ',') {
-	chop $out;
-	$out .= $pad . ($s->{xpad} x ($s->{level} - 1));
+        chop $out;
+        $out .= $pad . ($s->{xpad} x ($s->{level} - 1));
       }
       $out .= ($name =~ /^\%/) ? ')' : '}';
     }
     elsif ($realtype eq 'CODE') {
       if ($s->{deparse}) {
-	require B::Deparse;
-	my $sub =  'sub ' . (B::Deparse->new)->coderef2text($val);
-	$pad    =  $s->{sep} . $s->{pad} . $s->{apad} . $s->{xpad} x ($s->{level} - 1);
-	$sub    =~ s/\n/$pad/gse;
-	$out   .=  $sub;
-      } else {
+        require B::Deparse;
+        my $sub =  'sub ' . (B::Deparse->new)->coderef2text($val);
+        $pad    =  $s->{sep} . $s->{pad} . $s->{apad} . $s->{xpad} x ($s->{level} - 1);
+        $sub    =~ s/\n/$pad/gse;
+        $out   .=  $sub;
+      }
+      else {
         $out .= 'sub { "DUMMY" }';
         carp "Encountered CODE ref, using dummy placeholder" if $s->{purity};
       }
     }
     else {
-      croak "Can\'t handle $realtype type.";
+      croak "Can't handle '$realtype' type";
     }
-    
+
     if ($realpack and !$no_bless) { # we have a blessed ref
       $out .= ', ' . _quote($realpack) . ' )';
-      $out .= '->' . $s->{toaster} . '()'  if $s->{toaster} ne '';
+      $out .= '->' . $s->{toaster} . '()'
+        if $s->{toaster} ne '';
       $s->{apad} = $blesspad;
     }
     $s->{level}--;
-
   }
   else {                                 # simple scalar
 
     my $ref = \$_[1];
+    my $v;
     # first, catalog the scalar
     if ($name ne '') {
       $id = format_refaddr($ref);
       if (exists $s->{seen}{$id}) {
         if ($s->{seen}{$id}[2]) {
-	  $out = $s->{seen}{$id}[0];
-	  #warn "[<$out]\n";
-	  return "\${$out}";
-	}
+          $out = $s->{seen}{$id}[0];
+          #warn "[<$out]\n";
+          return "\${$out}";
+        }
       }
       else {
-	#warn "[>\\$name]\n";
-	$s->{seen}{$id} = ["\\$name", $ref];
+        #warn "[>\\$name]\n";
+        $s->{seen}{$id} = ["\\$name", $ref];
       }
     }
-    if (ref($ref) eq 'GLOB' or "$ref" =~ /=GLOB\([^()]+\)$/) {  # glob
+    $ref = \$val;
+    if (ref($ref) eq 'GLOB') {  # glob
       my $name = substr($val, 1);
-      if ($name =~ /^[A-Za-z_][\w:]*$/) {
-	$name =~ s/^main::/::/;
-	$sname = $name;
+      if ($name =~ /^[A-Za-z_][\w:]*$/ && $name ne 'main::') {
+        $name =~ s/^main::/::/;
+        $sname = $name;
       }
       else {
-	$sname = $s->_dump($name, "");
-	$sname = '{' . $sname . '}';
+        $sname = $s->_dump(
+          $name eq 'main::' || $] < 5.007 && $name eq "main::\0"
+            ? ''
+            : $name,
+          "",
+        );
+        $sname = '{' . $sname . '}';
       }
       if ($s->{purity}) {
-	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($gval, "\*$sname\{$k\}");
-	}
+        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($gval, "\*$sname\{$k\}");
+        }
       }
       $out .= '*' . $sname;
     }
     elsif (!defined($val)) {
       $out .= "undef";
     }
+    elsif (defined &_vstring and $v = _vstring($val)
+      and !_bad_vsmg || eval $v eq $val) {
+      $out .= $v;
+    }
+    elsif (!defined &_vstring
+       and ref $ref eq 'VSTRING' || eval{Scalar::Util::isvstring($val)}) {
+      $out .= sprintf "%vd", $val;
+    }
     elsif ($val =~ /^(?:0|-?[1-9]\d{0,8})\z/) { # safe decimal number
       $out .= $val;
     }
-    else {				 # string
+    else {                 # string
       if ($s->{useqq} or $val =~ tr/\0-\377//c) {
         # Fall back to qq if there's Unicode
-	$out .= qquote($val, $s->{useqq});
+        $out .= qquote($val, $s->{useqq});
       }
       else {
         $out .= _quote($val);
@@ -545,7 +590,7 @@ sub _dump {
   }
   return $out;
 }
-  
+
 #
 # non-OO style of earlier version
 #
@@ -558,12 +603,8 @@ sub DumperX {
   return Data::Dumper->Dumpxs([@_], []);
 }
 
-sub Dumpf { return Data::Dumper->Dump(@_) }
-
-sub Dumpp { print Data::Dumper->Dump(@_) }
-
 #
-# reset the "seen" cache 
+# reset the "seen" cache
 #
 sub Reset {
   my($s) = shift;
@@ -650,6 +691,11 @@ sub Maxdepth {
   defined($v) ? (($s->{'maxdepth'} = $v), return $s) : $s->{'maxdepth'};
 }
 
+sub Maxrecurse {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{'maxrecurse'} = $v), return $s) : $s->{'maxrecurse'};
+}
+
 sub Useperl {
   my($s, $v) = @_;
   defined($v) ? (($s->{'useperl'} = $v), return $s) : $s->{'useperl'};
@@ -665,8 +711,13 @@ sub Deparse {
   defined($v) ? (($s->{'deparse'} = $v), return $s) : $s->{'deparse'};
 }
 
+sub Sparseseen {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{'noseen'} = $v), return $s) : $s->{'noseen'};
+}
+
 # used by qquote below
-my %esc = (  
+my %esc = (
     "\a" => "\\a",
     "\b" => "\\b",
     "\t" => "\\t",
@@ -682,7 +733,7 @@ sub qquote {
   s/([\\\"\@\$])/\\$1/g;
   my $bytes; { use bytes; $bytes = length }
   s/([^\x00-\x7f])/'\x{'.sprintf("%x",ord($1)).'}'/ge if $bytes > length;
-  return qq("$_") unless 
+  return qq("$_") unless
     /[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~]/;  # fast exit
 
   my $high = shift || "";
@@ -719,6 +770,45 @@ sub qquote {
 # access to sortsv() from XS
 sub _sortkeys { [ sort keys %{$_[0]} ] }
 
+sub _refine_name {
+    my $s = shift;
+    my ($name, $val, $i) = @_;
+    if (defined $name) {
+      if ($name =~ /^[*](.*)$/) {
+        if (defined $val) {
+            $name = (ref $val eq 'ARRAY') ? ( "\@" . $1 ) :
+              (ref $val eq 'HASH')  ? ( "\%" . $1 ) :
+              (ref $val eq 'CODE')  ? ( "\*" . $1 ) :
+              ( "\$" . $1 ) ;
+        }
+        else {
+          $name = "\$" . $1;
+        }
+      }
+      elsif ($name !~ /^\$/) {
+        $name = "\$" . $name;
+      }
+    }
+    else { # no names provided
+      $name = "\$" . $s->{varname} . $i;
+    }
+    return $name;
+}
+
+sub _compose_out {
+    my $s = shift;
+    my ($valstr, $postref) = @_;
+    my $out = "";
+    $out .= $s->{pad} . $valstr . $s->{sep};
+    if (@{$postref}) {
+        $out .= $s->{pad} .
+            join(';' . $s->{sep} . $s->{pad}, @{$postref}) .
+            ';' .
+            $s->{sep};
+    }
+    return $out;
+}
+
 1;
 __END__
 
@@ -759,7 +849,8 @@ variable is output in a single Perl statement.  Handles self-referential
 structures correctly.
 
 The return value can be C<eval>ed to get back an identical copy of the
-original reference structure.
+original reference structure.  (Please do consider the security implications
+of eval'ing code from untrusted sources!)
 
 Any references that are the same as one of those passed in will be named
 C<$VAR>I<n> (where I<n> is a numeric suffix), and other duplicate references
@@ -777,7 +868,7 @@ these references.  Moreover, if C<eval>ed when strictures are in effect,
 you need to ensure that any variables it accesses are previously declared.
 
 In the extended usage form, the references to be dumped can be given
-user-specified names.  If a name begins with a C<*>, the output will 
+user-specified names.  If a name begins with a C<*>, the output will
 describe the dereferenced type of the supplied reference for hashes and
 arrays, and coderefs.  Output of names will be avoided where possible if
 the C<Terse> flag is set.
@@ -787,7 +878,7 @@ object will return the object itself, so method calls can be conveniently
 chained together.
 
 Several styles of output are possible, all controlled by setting
-the C<Indent> flag.  See L<Configuration Variables or Methods> below 
+the C<Indent> flag.  See L<Configuration Variables or Methods> below
 for details.
 
 
@@ -839,15 +930,21 @@ itself.
 
 =item I<$OBJ>->Values(I<[ARRAYREF]>)
 
-Queries or replaces the internal array of values that will be dumped.
-When called without arguments, returns the values.  Otherwise, returns the
-object itself.
+Queries or replaces the internal array of values that will be dumped.  When
+called without arguments, returns the values as a list.  When called with a
+reference to an array of replacement values, returns the object itself.  When
+called with any other type of argument, dies.
 
 =item I<$OBJ>->Names(I<[ARRAYREF]>)
 
 Queries or replaces the internal array of user supplied names for the values
-that will be dumped.  When called without arguments, returns the names.
-Otherwise, returns the object itself.
+that will be dumped.  When called without arguments, returns the names.  When
+called with an array of replacement names, returns the object itself.  If the
+number of replacment names exceeds the number of values to be named, the
+excess names will not be used.  If the number of replacement names falls short
+of the number of values to be named, the list of replacment names will be
+exhausted and remaining values will not be renamed.  When
+called with any other type of argument, dies.
 
 =item I<$OBJ>->Reset
 
@@ -874,7 +971,7 @@ in a list context.
 Several configuration variables can be used to control the kind of output
 generated when using the procedural interface.  These variables are usually
 C<local>ized in a block so that other parts of the code are not affected by
-the change.  
+the change.
 
 These variables determine the default state of the object created by calling
 the C<new> method, but cannot be used to alter the state of the object
@@ -987,7 +1084,7 @@ Cross-referencing will then only be done when absolutely essential
 $Data::Dumper::Quotekeys  I<or>  $I<OBJ>->Quotekeys(I<[NEWVAL]>)
 
 Can be set to a boolean value to control whether hash keys are quoted.
-A false value will avoid quoting hash keys when it looks like a simple
+A defined false value will avoid quoting hash keys when it looks like a simple
 string.  Default is 1, which will always enclose hash keys in quotes.
 
 =item *
@@ -1019,8 +1116,18 @@ $Data::Dumper::Maxdepth  I<or>  $I<OBJ>->Maxdepth(I<[NEWVAL]>)
 Can be set to a positive integer that specifies the depth beyond which
 we don't venture into a structure.  Has no effect when
 C<Data::Dumper::Purity> is set.  (Useful in debugger when we often don't
-want to see more than enough).  Default is 0, which means there is 
-no maximum depth. 
+want to see more than enough).  Default is 0, which means there is
+no maximum depth.
+
+=item *
+
+$Data::Dumper::Maxrecurse  I<or>  $I<OBJ>->Maxrecurse(I<[NEWVAL]>)
+
+Can be set to a positive integer that specifies the depth beyond which
+recursion into a structure will throw an exception.  This is intended
+as a security measure to prevent perl running out of stack space when
+dumping an excessively deep structure.  Can be set to 0 to remove the
+limit.  Default is 1000.
 
 =item *
 
@@ -1064,6 +1171,26 @@ XSUB implementation doesn't support it.
 Caution : use this option only if you know that your coderefs will be
 properly reconstructed by C<B::Deparse>.
 
+=item *
+
+$Data::Dumper::Sparseseen I<or>  $I<OBJ>->Sparseseen(I<[NEWVAL]>)
+
+By default, Data::Dumper builds up the "seen" hash of scalars that
+it has encountered during serialization. This is very expensive.
+This seen hash is necessary to support and even just detect circular
+references. It is exposed to the user via the C<Seen()> call both
+for writing and reading.
+
+If you, as a user, do not need explicit access to the "seen" hash,
+then you can set the C<Sparseseen> option to allow Data::Dumper
+to eschew building the "seen" hash for scalars that are known not
+to possess more than one reference. This speeds up serialization
+considerably if you use the XS implementation.
+
+Note: If you turn on C<Sparseseen>, then you must not rely on the
+content of the seen hash since its contents will be an
+implementation detail!
+
 =back
 
 =head2 Exports
@@ -1095,7 +1222,7 @@ distribution for more examples.)
     $foo = Foo->new;
     $fuz = Fuz->new;
     $boo = [ 1, [], "abcd", \*foo,
-             {1 => 'a', 023 => 'b', 0x45 => 'c'}, 
+             {1 => 'a', 023 => 'b', 0x45 => 'c'},
              \\"p\q\'r", $foo, $fuz];
 
     ########
@@ -1106,20 +1233,20 @@ distribution for more examples.)
     print($@) if $@;
     print Dumper($boo), Dumper($bar);  # pretty print (no array indices)
 
-    $Data::Dumper::Terse = 1;          # don't output names where feasible
-    $Data::Dumper::Indent = 0;         # turn off all pretty print
+    $Data::Dumper::Terse = 1;        # don't output names where feasible
+    $Data::Dumper::Indent = 0;       # turn off all pretty print
     print Dumper($boo), "\n";
 
-    $Data::Dumper::Indent = 1;         # mild pretty print
+    $Data::Dumper::Indent = 1;       # mild pretty print
     print Dumper($boo);
 
-    $Data::Dumper::Indent = 3;         # pretty print with array indices
+    $Data::Dumper::Indent = 3;       # pretty print with array indices
     print Dumper($boo);
 
-    $Data::Dumper::Useqq = 1;          # print strings in double quotes
+    $Data::Dumper::Useqq = 1;        # print strings in double quotes
     print Dumper($boo);
 
-    $Data::Dumper::Pair = " : ";       # specify hash key/value separator
+    $Data::Dumper::Pair = " : ";     # specify hash key/value separator
     print Dumper($boo);
 
 
@@ -1185,20 +1312,20 @@ distribution for more examples.)
     sub new { bless { state => 'awake' }, shift }
     sub Freeze {
         my $s = shift;
-	print STDERR "preparing to sleep\n";
-	$s->{state} = 'asleep';
-	return bless $s, 'Foo::ZZZ';
+        print STDERR "preparing to sleep\n";
+        $s->{state} = 'asleep';
+        return bless $s, 'Foo::ZZZ';
     }
 
     package Foo::ZZZ;
     sub Thaw {
         my $s = shift;
-	print STDERR "waking up\n";
-	$s->{state} = 'awake';
-	return bless $s, 'Foo';
+        print STDERR "waking up\n";
+        $s->{state} = 'awake';
+        return bless $s, 'Foo';
     }
 
-    package Foo;
+    package main;
     use Data::Dumper;
     $a = Foo->new;
     $b = Data::Dumper->new([$a], ['c']);
@@ -1297,7 +1424,7 @@ modify it under the same terms as Perl itself.
 
 =head1 VERSION
 
-Version 2.125  (Aug  8 2009)
+Version 2.145  (March 15 2013))
 
 =head1 SEE ALSO
 
diff --git a/gnu/usr.bin/perl/dist/Data-Dumper/Dumper.xs b/gnu/usr.bin/perl/dist/Data-Dumper/Dumper.xs
index e3867a18383..a376f1fccb9 100644
--- a/gnu/usr.bin/perl/dist/Data-Dumper/Dumper.xs
+++ b/gnu/usr.bin/perl/dist/Data-Dumper/Dumper.xs
@@ -12,22 +12,31 @@
 #  define DD_USE_OLD_ID_FORMAT
 #endif
 
+#ifndef isWORDCHAR
+#   define isWORDCHAR(c) isALNUM(c)
+#endif
+
 static I32 num_q (const char *s, STRLEN slen);
 static I32 esc_q (char *dest, const char *src, STRLEN slen);
 static I32 esc_q_utf8 (pTHX_ SV *sv, const char *src, STRLEN slen);
-static I32 needs_quote(register const char *s);
+static I32 needs_quote(const char *s, STRLEN len);
 static SV *sv_x (pTHX_ SV *sv, const char *str, STRLEN len, I32 n);
 static I32 DD_dump (pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval,
 		    HV *seenhv, AV *postav, I32 *levelp, I32 indent,
 		    SV *pad, SV *xpad, SV *apad, SV *sep, SV *pair,
 		    SV *freezer, SV *toaster,
 		    I32 purity, I32 deepcopy, I32 quotekeys, SV *bless,
-		    I32 maxdepth, SV *sortkeys);
+		    I32 maxdepth, SV *sortkeys, int use_sparse_seen_hash,
+		    IV maxrecurse);
 
 #ifndef HvNAME_get
 #define HvNAME_get HvNAME
 #endif
 
+/* Perls 7 through portions of 15 used utf8_to_uvchr() which didn't have a
+ * length parameter.  This wrongly allowed reading beyond the end of buffer
+ * given malformed input */
+
 #if PERL_VERSION <= 6 /* Perl 5.6 and earlier */
 
 # ifdef EBCDIC
@@ -37,21 +46,43 @@ static I32 DD_dump (pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval,
 # endif
 
 UV
-Perl_utf8_to_uvchr(pTHX_ U8 *s, STRLEN *retlen)
+Perl_utf8_to_uvchr_buf(pTHX_ U8 *s, U8 *send, STRLEN *retlen)
 {
-    const UV uv = utf8_to_uv(s, UTF8_MAXLEN, retlen,
+    const UV uv = utf8_to_uv(s, send - s, retlen,
                     ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
     return UNI_TO_NATIVE(uv);
 }
 
 # if !defined(PERL_IMPLICIT_CONTEXT)
-#  define utf8_to_uvchr	     Perl_utf8_to_uvchr
+#  define utf8_to_uvchr_buf	     Perl_utf8_to_uvchr_buf
 # else
-#  define utf8_to_uvchr(a,b) Perl_utf8_to_uvchr(aTHX_ a,b)
+#  define utf8_to_uvchr_buf(a,b,c) Perl_utf8_to_uvchr_buf(aTHX_ a,b,c)
 # endif
 
 #endif /* PERL_VERSION <= 6 */
 
+/* Perl 5.7 through part of 5.15 */
+#if PERL_VERSION > 6 && PERL_VERSION <= 15 && ! defined(utf8_to_uvchr_buf)
+
+UV
+Perl_utf8_to_uvchr_buf(pTHX_ U8 *s, U8 *send, STRLEN *retlen)
+{
+    /* We have to discard <send> for these versions; hence can read off the
+     * end of the buffer if there is a malformation that indicates the
+     * character is longer than the space available */
+
+    const UV uv = utf8_to_uvchr(s, retlen);
+    return UNI_TO_NATIVE(uv);
+}
+
+# if !defined(PERL_IMPLICIT_CONTEXT)
+#  define utf8_to_uvchr_buf	     Perl_utf8_to_uvchr_buf
+# else
+#  define utf8_to_uvchr_buf(a,b,c) Perl_utf8_to_uvchr_buf(aTHX_ a,b,c)
+# endif
+
+#endif /* PERL_VERSION > 6 && <= 15 */
+
 /* Changes in 5.7 series mean that now IOK is only set if scalar is
    precisely integer but in 5.6 and earlier we need to do a more
    complex test  */
@@ -63,11 +94,12 @@ Perl_utf8_to_uvchr(pTHX_ U8 *s, STRLEN *retlen)
 
 /* does a string need to be protected? */
 static I32
-needs_quote(register const char *s)
+needs_quote(const char *s, STRLEN len)
 {
+    const char *send = s+len;
 TOP:
     if (s[0] == ':') {
-	if (*++s) {
+	if (++s<send) {
 	    if (*s++ != ':')
 		return 1;
 	}
@@ -75,8 +107,8 @@ TOP:
 	    return 1;
     }
     if (isIDFIRST(*s)) {
-	while (*++s)
-	    if (!isALNUM(*s)) {
+	while (++s<send)
+	    if (!isWORDCHAR(*s)) {
 		if (*s == ':')
 		    goto TOP;
 		else
@@ -90,9 +122,9 @@ TOP:
 
 /* count the number of "'"s and "\"s in string */
 static I32
-num_q(register const char *s, register STRLEN slen)
+num_q(const char *s, STRLEN slen)
 {
-    register I32 ret = 0;
+    I32 ret = 0;
 
     while (slen > 0) {
 	if (*s == '\'' || *s == '\\')
@@ -108,9 +140,9 @@ num_q(register const char *s, register STRLEN slen)
 /* slen number of characters in s will be escaped */
 /* destination must be long enough for additional chars */
 static I32
-esc_q(register char *d, register const char *s, register STRLEN slen)
+esc_q(char *d, const char *s, STRLEN slen)
 {
-    register I32 ret = 0;
+    I32 ret = 0;
 
     while (slen > 0) {
 	switch (*s) {
@@ -128,7 +160,7 @@ esc_q(register char *d, register const char *s, register STRLEN slen)
 }
 
 static I32
-esc_q_utf8(pTHX_ SV* sv, register const char *src, register STRLEN slen)
+esc_q_utf8(pTHX_ SV* sv, const char *src, STRLEN slen)
 {
     char *r, *rstart;
     const char *s = src;
@@ -142,10 +174,14 @@ esc_q_utf8(pTHX_ SV* sv, register const char *src, register STRLEN slen)
     STRLEN single_quotes = 0;
     STRLEN qq_escapables = 0;	/* " $ @ will need a \ in "" strings.  */
     STRLEN normal = 0;
+    int increment;
 
     /* this will need EBCDICification */
-    for (s = src; s < send; s += UTF8SKIP(s)) {
-        const UV k = utf8_to_uvchr((U8*)s, NULL);
+    for (s = src; s < send; s += increment) {
+        const UV k = utf8_to_uvchr_buf((U8*)s, (U8*) send, NULL);
+
+        /* check for invalid utf8 */
+        increment = (k == 0 && *s != '\0') ? 1 : UTF8SKIP(s);
 
 #ifdef EBCDIC
 	if (!isprint(k) || k > 256) {
@@ -179,7 +215,7 @@ esc_q_utf8(pTHX_ SV* sv, register const char *src, register STRLEN slen)
         *r++ = '"';
 
         for (s = src; s < send; s += UTF8SKIP(s)) {
-            const UV k = utf8_to_uvchr((U8*)s, NULL);
+            const UV k = utf8_to_uvchr_buf((U8*)s, (U8*) send, NULL);
 
             if (k == '"' || k == '\\' || k == '$' || k == '@') {
                 *r++ = '\\';
@@ -262,7 +298,8 @@ static I32
 DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
 	AV *postav, I32 *levelp, I32 indent, SV *pad, SV *xpad,
 	SV *apad, SV *sep, SV *pair, SV *freezer, SV *toaster, I32 purity,
-	I32 deepcopy, I32 quotekeys, SV *bless, I32 maxdepth, SV *sortkeys)
+	I32 deepcopy, I32 quotekeys, SV *bless, I32 maxdepth, SV *sortkeys,
+        int use_sparse_seen_hash, IV maxrecurse)
 {
     char tmpbuf[128];
     U32 i;
@@ -289,7 +326,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
     if (!val)
 	return 0;
 
-    /* If the ouput buffer has less than some arbitary amount of space
+    /* If the ouput buffer has less than some arbitrary amount of space
        remaining, then enlarge it. For the test case (25M of output),
        *1.1 was slower, *2.0 was the same, so the first guess of 1.5 is
 	deemed to be good enough.  */
@@ -312,7 +349,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
 	{
 	    dSP; ENTER; SAVETMPS; PUSHMARK(sp);
 	    XPUSHs(val); PUTBACK;
-	    i = perl_call_method(SvPVX_const(freezer), G_EVAL|G_VOID);
+	    i = perl_call_method(SvPVX_const(freezer), G_EVAL|G_VOID|G_DISCARD);
 	    SPAGAIN;
 	    if (SvTRUE(ERRSV))
 		warn("WARNING(Freezer method call failed): %"SVf"", ERRSV);
@@ -439,6 +476,10 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
 	    return 1;
 	}
 
+	if (maxrecurse > 0 && *levelp >= maxrecurse) {
+	    croak("Recursion limit of %" IVdf " exceeded", maxrecurse);
+	}
+
 	if (realpack && !no_bless) {				/* we have a blessed ref */
 	    STRLEN blesslen;
 	    const char * const blessstr = SvPV(bless, blesslen);
@@ -458,14 +499,17 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
         {
             STRLEN rlen;
 	    const char *rval = SvPV(val, rlen);
-	    const char *slash = strchr(rval, '/');
+	    const char * const rend = rval+rlen;
+	    const char *slash = rval;
 	    sv_catpvn(retval, "qr/", 3);
-	    while (slash) {
+	    for (;slash < rend; slash++) {
+	      if (*slash == '\\') { ++slash; continue; }
+	      if (*slash == '/') {    
 		sv_catpvn(retval, rval, slash-rval);
 		sv_catpvn(retval, "\\/", 2);
 		rlen -= slash-rval+1;
 		rval = slash+1;
-		slash = strchr(rval, '/');
+	      }
 	    }
 	    sv_catpvn(retval, rval, rlen);
 	    sv_catpvn(retval, "/", 1);
@@ -485,7 +529,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
 		DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
 			postav, levelp,	indent, pad, xpad, apad, sep, pair,
 			freezer, toaster, purity, deepcopy, quotekeys, bless,
-			maxdepth, sortkeys);
+			maxdepth, sortkeys, use_sparse_seen_hash, maxrecurse);
 		sv_catpvn(retval, ")}", 2);
 	    }						     /* plain */
 	    else {
@@ -493,7 +537,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
 		DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
 			postav, levelp,	indent, pad, xpad, apad, sep, pair,
 			freezer, toaster, purity, deepcopy, quotekeys, bless,
-			maxdepth, sortkeys);
+			maxdepth, sortkeys, use_sparse_seen_hash, maxrecurse);
 	    }
 	    SvREFCNT_dec(namesv);
 	}
@@ -505,7 +549,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
 	    DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
 		    postav, levelp,	indent, pad, xpad, apad, sep, pair,
 		    freezer, toaster, purity, deepcopy, quotekeys, bless,
-		    maxdepth, sortkeys);
+		    maxdepth, sortkeys, use_sparse_seen_hash, maxrecurse);
 	    SvREFCNT_dec(namesv);
 	}
 	else if (realtype == SVt_PVAV) {
@@ -578,7 +622,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
 		DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav,
 			levelp,	indent, pad, xpad, apad, sep, pair,
 			freezer, toaster, purity, deepcopy, quotekeys, bless,
-			maxdepth, sortkeys);
+			maxdepth, sortkeys, use_sparse_seen_hash, maxrecurse);
 		if (ix < ixmax)
 		    sv_catpvn(retval, ",", 1);
 	    }
@@ -643,7 +687,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
 		    (void)hv_iterinit((HV*)ival);
 		    while ((entry = hv_iternext((HV*)ival))) {
 			sv = hv_iterkeysv(entry);
-			SvREFCNT_inc(sv);
+			(void)SvREFCNT_inc(sv);
 			av_push(keys, sv);
 		    }
 # ifdef USE_LOCALE_NUMERIC
@@ -699,11 +743,11 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
 		if (sortkeys) {
 		    char *key;
 		    svp = av_fetch(keys, i, FALSE);
-		    keysv = svp ? *svp : sv_mortalcopy(&PL_sv_undef);
+		    keysv = svp ? *svp : sv_newmortal();
 		    key = SvPV(keysv, keylen);
 		    svp = hv_fetch((HV*)ival, key,
-                                   SvUTF8(keysv) ? -(I32)keylen : keylen, 0);
-		    hval = svp ? *svp : sv_mortalcopy(&PL_sv_undef);
+                                   SvUTF8(keysv) ? -(I32)keylen : (I32)keylen, 0);
+		    hval = svp ? *svp : sv_newmortal();
 		}
 		else {
 		    keysv = hv_iterkeysv(entry);
@@ -737,7 +781,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
                    more common doesn't need quoting case.
                    The code is also smaller (22044 vs 22260) because I've been
                    able to pull the common logic out to both sides.  */
-                if (quotekeys || needs_quote(key)) {
+                if (quotekeys || needs_quote(key,keylen)) {
                     if (do_utf8) {
                         STRLEN ocur = SvCUR(retval);
                         nlen = esc_q_utf8(aTHX_ retval, key, klen);
@@ -785,7 +829,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
 		DD_dump(aTHX_ hval, SvPVX_const(sname), SvCUR(sname), retval, seenhv,
 			postav, levelp,	indent, pad, xpad, newapad, sep, pair,
 			freezer, toaster, purity, deepcopy, quotekeys, bless,
-			maxdepth, sortkeys);
+			maxdepth, sortkeys, use_sparse_seen_hash, maxrecurse);
 		SvREFCNT_dec(sname);
 		Safefree(nkey_buffer);
 		if (indent >= 2)
@@ -810,7 +854,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
 		warn("Encountered CODE ref, using dummy placeholder");
 	}
 	else {
-	    warn("cannot handle ref type %ld", realtype);
+	    warn("cannot handle ref type %d", (int)realtype);
 	}
 
 	if (realpack && !no_bless) {  /* free blessed allocs */
@@ -852,6 +896,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
     }
     else {
 	STRLEN i;
+	const MAGIC *mg;
 	
 	if (namelen) {
 #ifdef DD_USE_OLD_ID_FORMAT
@@ -874,7 +919,14 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
 		    return 1;
 		}
 	    }
-	    else if (val != &PL_sv_undef) {
+            /* If we're allowed to keep only a sparse "seen" hash
+             * (IOW, the user does not expect it to contain everything
+             * after the dump, then only store in seen hash if the SV
+             * ref count is larger than 1. If it's 1, then we know that
+             * there is no other reference, duh. This is an optimization.
+             * Note that we'd have to check for weak-refs, too, but this is
+             * already the branch for non-refs only. */
+	    else if (val != &PL_sv_undef && (!use_sparse_seen_hash || SvREFCNT(val) > 1)) {
 		SV * const namesv = newSVpvn("\\", 1);
 		sv_catpvn(namesv, name, namelen);
 		seenentry = newAV();
@@ -909,12 +961,32 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
 	}
 	else if (realtype == SVt_PVGV) {/* GLOBs can end up with scribbly names */
 	    c = SvPV(val, i);
-	    ++c; --i;			/* just get the name */
+	    if(i) ++c, --i;			/* just get the name */
 	    if (i >= 6 && strncmp(c, "main::", 6) == 0) {
 		c += 4;
-		i -= 4;
+#if PERL_VERSION < 7
+		if (i == 6 || (i == 7 && c[6] == '\0'))
+#else
+		if (i == 6)
+#endif
+		    i = 0; else i -= 4;
 	    }
-	    if (needs_quote(c)) {
+	    if (needs_quote(c,i)) {
+#ifdef GvNAMEUTF8
+	      if (GvNAMEUTF8(val)) {
+		sv_grow(retval, SvCUR(retval)+2);
+		r = SvPVX(retval)+SvCUR(retval);
+		r[0] = '*'; r[1] = '{';
+		SvCUR_set(retval, SvCUR(retval)+2);
+		esc_q_utf8(aTHX_ retval, c, i);
+		sv_grow(retval, SvCUR(retval)+2);
+		r = SvPVX(retval)+SvCUR(retval);
+		r[0] = '}'; r[1] = '\0';
+		i = 1;
+	      }
+	      else
+#endif
+	      {
 		sv_grow(retval, SvCUR(retval)+6+2*i);
 		r = SvPVX(retval)+SvCUR(retval);
 		r[0] = '*'; r[1] = '{';	r[2] = '\'';
@@ -922,6 +994,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
 		i += 3;
 		r[i++] = '\''; r[i++] = '}';
 		r[i] = '\0';
+	      }
 	    }
 	    else {
 		sv_grow(retval, SvCUR(retval)+i+2);
@@ -965,7 +1038,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
 				seenhv, postav, &nlevel, indent, pad, xpad,
 				newapad, sep, pair, freezer, toaster, purity,
 				deepcopy, quotekeys, bless, maxdepth, 
-				sortkeys);
+				sortkeys, use_sparse_seen_hash, maxrecurse);
 			SvREFCNT_dec(e);
 		    }
 		}
@@ -977,6 +1050,20 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
 	else if (val == &PL_sv_undef || !SvOK(val)) {
 	    sv_catpvn(retval, "undef", 5);
 	}
+#ifdef SvVOK
+	else if (SvMAGICAL(val) && (mg = mg_find(val, 'V'))) {
+# if !defined(PL_vtbl_vstring) && PERL_VERSION < 17
+	    SV * const vecsv = sv_newmortal();
+#  if PERL_VERSION < 10
+	    scan_vstring(mg->mg_ptr, vecsv);
+#  else
+	    scan_vstring(mg->mg_ptr, mg->mg_ptr + mg->mg_len, vecsv);
+#  endif
+	    if (!sv_eq(vecsv, val)) goto integer_came_from_string;
+# endif
+	    sv_catpvn(retval, (const char *)mg->mg_ptr, mg->mg_len);
+	}
+#endif
 	else {
         integer_came_from_string:
 	    c = SvPV(val, i);
@@ -1012,7 +1099,7 @@ MODULE = Data::Dumper		PACKAGE = Data::Dumper         PREFIX = Data_Dumper_
 #
 # This is the exact equivalent of Dump.  Well, almost. The things that are
 # different as of now (due to Laziness):
-#   * doesnt do double-quotes yet.
+#   * doesn't do double-quotes yet.
 #
 
 void
@@ -1031,8 +1118,10 @@ Data_Dumper_Dumpxs(href, ...)
 	    SV *val, *name, *pad, *xpad, *apad, *sep, *pair, *varname;
 	    SV *freezer, *toaster, *bless, *sortkeys;
 	    I32 purity, deepcopy, quotekeys, maxdepth = 0;
+	    IV maxrecurse = 1000;
 	    char tmpbuf[1024];
 	    I32 gimme = GIMME;
+            int use_sparse_seen_hash = 0;
 
 	    if (!SvROK(href)) {		/* call new to get an object first */
 		if (items < 2)
@@ -1042,10 +1131,11 @@ Data_Dumper_Dumpxs(href, ...)
 		SAVETMPS;
 		
 		PUSHMARK(sp);
-		XPUSHs(href);
-		XPUSHs(sv_2mortal(newSVsv(ST(1))));
+                EXTEND(SP, 3); /* 3 == max of all branches below */
+		PUSHs(href);
+		PUSHs(sv_2mortal(newSVsv(ST(1))));
 		if (items >= 3)
-		    XPUSHs(sv_2mortal(newSVsv(ST(2))));
+		    PUSHs(sv_2mortal(newSVsv(ST(2))));
 		PUTBACK;
 		i = perl_call_method("new", G_SCALAR);
 		SPAGAIN;
@@ -1075,6 +1165,10 @@ Data_Dumper_Dumpxs(href, ...)
 
 		if ((svp = hv_fetch(hv, "seen", 4, FALSE)) && SvROK(*svp))
 		    seenhv = (HV*)SvRV(*svp);
+                else
+                    use_sparse_seen_hash = 1;
+		if ((svp = hv_fetch(hv, "noseen", 6, FALSE)))
+		    use_sparse_seen_hash = (SvOK(*svp) && SvIV(*svp) != 0);
 		if ((svp = hv_fetch(hv, "todump", 6, FALSE)) && SvROK(*svp))
 		    todumpav = (AV*)SvRV(*svp);
 		if ((svp = hv_fetch(hv, "names", 5, FALSE)) && SvROK(*svp))
@@ -1113,6 +1207,8 @@ Data_Dumper_Dumpxs(href, ...)
 		    bless = *svp;
 		if ((svp = hv_fetch(hv, "maxdepth", 8, FALSE)))
 		    maxdepth = SvIV(*svp);
+		if ((svp = hv_fetch(hv, "maxrecurse", 10, FALSE)))
+		    maxrecurse = SvIV(*svp);
 		if ((svp = hv_fetch(hv, "sortkeys", 8, FALSE))) {
 		    sortkeys = *svp;
 		    if (! SvTRUE(sortkeys))
@@ -1179,7 +1275,7 @@ Data_Dumper_Dumpxs(href, ...)
 			sv_catpvn(name, tmpbuf, nchars);
 		    }
 		
-		    if (indent >= 2) {
+		    if (indent >= 2 && !terse) {
 			SV * const tmpsv = sv_x(aTHX_ NULL, " ", 1, SvCUR(name)+3);
 			newapad = newSVsv(apad);
 			sv_catsv(newapad, tmpsv);
@@ -1188,12 +1284,15 @@ Data_Dumper_Dumpxs(href, ...)
 		    else
 			newapad = apad;
 		
+		    PUTBACK;
 		    DD_dump(aTHX_ val, SvPVX_const(name), SvCUR(name), valstr, seenhv,
 			    postav, &level, indent, pad, xpad, newapad, sep, pair,
 			    freezer, toaster, purity, deepcopy, quotekeys,
-			    bless, maxdepth, sortkeys);
+			    bless, maxdepth, sortkeys, use_sparse_seen_hash,
+			    maxrecurse);
+		    SPAGAIN;
 		
-		    if (indent >= 2)
+		    if (indent >= 2 && !terse)
 			SvREFCNT_dec(newapad);
 
 		    postlen = av_len(postav);
@@ -1238,3 +1337,21 @@ Data_Dumper_Dumpxs(href, ...)
 	    if (gimme == G_SCALAR)
 		XPUSHs(sv_2mortal(retval));
 	}
+
+SV *
+Data_Dumper__vstring(sv)
+	SV	*sv;
+	PROTOTYPE: $
+	CODE:
+	{
+#ifdef SvVOK
+	    const MAGIC *mg;
+	    RETVAL =
+		SvMAGICAL(sv) && (mg = mg_find(sv, 'V'))
+		 ? newSVpvn((const char *)mg->mg_ptr, mg->mg_len)
+		 : &PL_sv_undef;
+#else
+	    RETVAL = &PL_sv_undef;
+#endif
+	}
+	OUTPUT: RETVAL
diff --git a/gnu/usr.bin/perl/dist/Data-Dumper/t/recurse.t b/gnu/usr.bin/perl/dist/Data-Dumper/t/recurse.t
new file mode 100644
index 00000000000..275a89d2362
--- /dev/null
+++ b/gnu/usr.bin/perl/dist/Data-Dumper/t/recurse.t
@@ -0,0 +1,45 @@
+#!perl
+
+# Test the Maxrecurse option
+
+use strict;
+use Test::More tests => 32;
+use Data::Dumper;
+
+SKIP: {
+    skip "no XS available", 16
+      if $Data::Dumper::Useperl;
+    local $Data::Dumper::Useperl = 1;
+    test_recursion();
+}
+
+test_recursion();
+
+sub test_recursion {
+    my $pp = $Data::Dumper::Useperl ? "pure perl" : "XS";
+    $Data::Dumper::Purity = 1; # make sure this has no effect
+    $Data::Dumper::Indent = 0;
+    $Data::Dumper::Maxrecurse = 1;
+    is(eval { Dumper([]) }, '$VAR1 = [];', "$pp: maxrecurse 1, []");
+    is(eval { Dumper([[]]) }, undef, "$pp: maxrecurse 1, [[]]");
+    ok($@, "exception thrown");
+    is(eval { Dumper({}) }, '$VAR1 = {};', "$pp: maxrecurse 1, {}");
+    is(eval { Dumper({ a => 1 }) }, q($VAR1 = {'a' => 1};),
+       "$pp: maxrecurse 1, { a => 1 }");
+    is(eval { Dumper({ a => {} }) }, undef, "$pp: maxrecurse 1, { a => {} }");
+    ok($@, "exception thrown");
+    is(eval { Dumper(\1) }, "\$VAR1 = \\1;", "$pp: maxrecurse 1, \\1");
+    is(eval { Dumper(\\1) }, undef, "$pp: maxrecurse 1, \\1");
+    ok($@, "exception thrown");
+    $Data::Dumper::Maxrecurse = 3;
+    is(eval { Dumper(\1) }, "\$VAR1 = \\1;", "$pp: maxrecurse 3, \\1");
+    is(eval { Dumper(\(my $s = {})) }, "\$VAR1 = \\{};", "$pp: maxrecurse 3, \\{}");
+    is(eval { Dumper(\(my $s = { a => [] })) }, "\$VAR1 = \\{'a' => []};",
+       "$pp: maxrecurse 3, \\{ a => [] }");
+    is(eval { Dumper(\(my $s = { a => [{}] })) }, undef,
+       "$pp: maxrecurse 3, \\{ a => [{}] }");
+    ok($@, "exception thrown");
+    $Data::Dumper::Maxrecurse = 0;
+    is(eval { Dumper([[[[[]]]]]) }, q($VAR1 = [[[[[]]]]];),
+       "$pp: check Maxrecurse doesn't set limit to 0 recursion");
+}
diff --git a/gnu/usr.bin/perl/patchlevel.h b/gnu/usr.bin/perl/patchlevel.h
index d51767c573f..b07ef618009 100644
--- a/gnu/usr.bin/perl/patchlevel.h
+++ b/gnu/usr.bin/perl/patchlevel.h
@@ -134,6 +134,7 @@ hunk.
 static const char * const local_patches[] = {
 	NULL
 	,"Update libnet to 1.27"
+	,"CVE-2014-4330"
 #ifdef PERL_GIT_UNCOMMITTED_CHANGES
 	,"uncommitted-changes"
 #endif