--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/components/perl512/patches/CVE-2014-4330.patch Mon Oct 20 13:21:12 2014 -0700
@@ -0,0 +1,13429 @@
+This patch is an update of Data-Dumper to version 2.154 that comes from:
+http://search.cpan.org/~smueller/Data-Dumper-2.154/Dumper.pm
+
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/Changes perl-5.12.5_dumper/dist/Data-Dumper/Changes
+--- perl-5.12.5/dist/Data-Dumper/Changes 2012-11-03 19:25:59.000000000 -0400
++++ perl-5.12.5_dumper/dist/Data-Dumper/Changes 2014-10-09 15:06:36.166260359 -0400
+@@ -1,11 +1,165 @@
+ =head1 NAME
+
+-HISTORY - public release history for Data::Dumper
++Changes - public release history for Data::Dumper
+
+ =head1 DESCRIPTION
+
+ =over 8
+
++=item 2.154 (Sep 18 2014)
++
++Most notably, this release fixes CVE-2014-4330:
++
++ Don't recurse infinitely in Data::Dumper
++
++ Add a configuration variable/option to limit recursion when dumping
++ deep data structures.
++ [...]
++ This patch addresses CVE-2014-4330. This bug was found and
++ reported by: LSE Leading Security Experts GmbH employee Markus
++ Vervier.
++
++On top of that, there are several minor big fixes and improvements,
++see "git log" if the core perl distribution for details.
++
++=item 2.151 (Mar 7 2014)
++
++A "useqq" implementation for the XS version of Data::Dumper.
++
++Better compatibility wrt. hash key quoting between PP and XS
++versions of Data::Dumper.
++
++EBCDIC fixes.
++
++64bit safety fixes (for very large arrays).
++
++Build fixes for threaded perls.
++
++clang warning fixes.
++
++Warning fixes in tests on older perls.
++
++Typo fixes in documentation.
++
++=item 2.145 (Mar 15 2013)
++
++Test refactoring and fixing wide and far.
++
++Various old-perl compat fixes.
++
++=item 2.143 (Feb 26 2013)
++
++Address vstring related test failures on 5.8: Skip tests for
++obscure case.
++
++Major improvements to test coverage and significant refactoring.
++
++Make Data::Dumper XS ignore Freezer return value. Fixes RT #116364.
++
++Change call of isALNUM to equivalent but more clearly named isWORDCHAR
++
++=item 2.139 (Dec 12 2012)
++
++Supply an explicit dynamic_config => 0 in META
++
++Properly list BUILD_REQUIRES prereqs (P5-RT#116028)
++
++Some optimizations. Removed useless "register" declarations.
++
++=item 2.136 (Oct 04 2012)
++
++Promote to stable release.
++
++Drop some "register" declarations.
++
++=item 2.135_07 (Aug 06 2012)
++
++Use the new utf8 to code point functions - fixing a potential
++reading buffer overrun.
++
++Data::Dumper: Sparseseen option to avoid building much of the seen
++hash: This has been measured to, in some cases, provide a 50% speed-up
++
++Dumper.xs: Avoid scan_vstring on 5.17.3 and up
++
++Avoid a warning from clang when compiling Data::Dumper
++
++Fix DD's dumping of qr|\/|
++
++Data::Dumper's Perl implementation was not working with overloaded
++blessed globs, which it thought were strings.
++
++Allow Data::Dumper to load on miniperl
++
++=item 2.135_02 (Dec 29 2011)
++
++Makes DD dump *{''} properly.
++
++[perl #101162] DD support for vstrings:
++Support for vstrings to Data::Dumper, in both Perl and XS
++implementations.
++
++=item 2.135_01 (Dec 19 2011)
++
++Make Data::Dumper UTF8- and null-clean with GVs.
++
++In Dumper.xs, use sv_newmortal() instead of sv_mortalcopy(&PL_sv_undef)
++for efficiency.
++
++Suppress compiler warning
++
++Keep verbatim pod in Data::Dumper within 80 cols
++
++=item 2.131 (May 27 2011)
++
++Essentially the same as version 2.130_02, but a production release.
++
++=item 2.130_03 (May 20 2011)
++
++Essentially the same as version 2.130_02, but a CPAN release
++for the eventual 2.131.
++
++=item 2.130_02
++
++This was only shipped with the perl core, never released to CPAN.
++
++Convert overload.t to Test::More
++
++Fix some spelling errors
++
++Fix some compiler warnings
++
++Fix an out of bounds write in Data-Dumper with malformed utf8 input
++
++=item 2.130 (Nov 20 2010)
++
++C<Dumpxs> can now handle malformed UTF-8.
++
++=item 2.129 (Oct 20 2010)
++
++C<Dumpxs> no longer crashes with globs returned by C<*$io_ref>
++[perl #72332].
++
++=item 2.128 (Sep 10 2010)
++
++Promote previous release to stable version with the correct version.
++
++=item 2.127 (Sep 10 2010)
++
++Promote previous release to stable version.
++
++=item 2.126_01 (Sep 6 2010)
++
++Port core perl changes e3ec2293dc, fe642606b19.
++Fixes core perl RT #74170 (handle the stack changing in the
++custom sort functions) and adds a test.
++
++=item 2.126 (Apr 15 2010)
++
++Fix Data::Dumper's Fix Terse(1) + Indent(2):
++perl-RT #73604: When $Data::Dumper::Terse is true, the indentation is thrown
++off. It appears to be acting as if the $VAR1 = is still there.
++
+ =item 2.125 (Aug 8 2009)
+
+ CPAN distribution fixes (meta information for META.yml).
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/Dumper.pm perl-5.12.5_dumper/dist/Data-Dumper/Dumper.pm
+--- perl-5.12.5/dist/Data-Dumper/Dumper.pm 2012-11-03 19:25:59.000000000 -0400
++++ perl-5.12.5_dumper/dist/Data-Dumper/Dumper.pm 2014-10-09 15:06:36.167092691 -0400
+@@ -9,7 +9,9 @@
+
+ package Data::Dumper;
+
+-$VERSION = '2.125'; # Don't forget to set version and release date in POD!
++BEGIN {
++ $VERSION = '2.154'; # Don't forget to set version and release
++} # date in POD below!
+
+ #$| = 1;
+
+@@ -28,13 +30,13 @@
+ # 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 @@
+ $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 @@
+ 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, # do not 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 @@
+ 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 @@
+ 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 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 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,8 @@
+
+ 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::Deparse || (ref($_[0]) && $_[0]->{deparse});
+ return &Dumpperl;
+ }
+
+@@ -208,40 +241,19 @@
+ $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 +267,10 @@
+ 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 +279,7 @@
+ #
+ 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 +296,70 @@
+ }
+
+ 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 do not 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;
+ }
+- my $no_bless = 0;
++ else {
++ # store our name
++ $s->{seen}{$id} = [ (
++ ($name =~ /^[@%]/)
++ ? ('\\' . $name )
++ : ($realtype eq 'CODE' and $name =~ /^[*](.*)$/)
++ ? ('\\&' . $1 )
++ : $name
++ ), $val ];
++ }
++ 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,186 +367,208 @@
+ }
+
+ $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
+- # universal.c, and even worse we cant just require that re to be loaded
+- # 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
+- # as the pattern will be repeatedly wrapped with the same modifiers.
+- # This is an aesthetic issue so we will leave it for now, but we could use
+- # regexp_pattern() in list context to get the modifiers separately.
+- # 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";
++ my $flags = "";
++ if (defined(*re::regexp_pattern{CODE})) {
++ ($pat, $flags) = re::regexp_pattern($val);
++ }
++ else {
++ $pat = "$val";
+ }
+- $pat =~ s,/,\\/,g;
+- $out .= "qr/$pat/";
++ $pat =~ s <(\\.)|/> { $1 || '\\/' }ge;
++ $out .= "qr/$pat/$flags";
+ }
+- 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, "");
++
++ # _dump doesn't quote numbers of this form
++ if ($s->{quotekeys} && $nk =~ /^(?:0|-?[1-9][0-9]{0,8})\z/) {
++ $nk = $s->{useqq} ? qq("$nk") : qq('$nk');
++ }
++ elsif (!$s->{quotekeys} and $nk =~ /^[\"\']([A-Za-z_]\w*)[\"\']$/) {
++ $nk = $1
++ }
++
++ $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 ($val =~ /^(?:0|-?[1-9]\d{0,8})\z/) { # safe decimal number
++ 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;
++ }
++ # \d here would treat "1\x{660}" as a safe decimal number
++ elsif ($val =~ /^(?:0|-?[1-9][0-9]{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 +587,7 @@
+ }
+ return $out;
+ }
+-
++
+ #
+ # non-OO style of earlier version
+ #
+@@ -558,12 +600,8 @@
+ 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 +688,11 @@
+ 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 +708,13 @@
+ 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",
+@@ -681,8 +729,8 @@
+ local($_) = shift;
+ s/([\\\"\@\$])/\\$1/g;
+ my $bytes; { use bytes; $bytes = length }
+- s/([^\x00-\x7f])/'\x{'.sprintf("%x",ord($1)).'}'/ge if $bytes > length;
+- return qq("$_") unless
++ s/([[:^ascii:]])/'\x{'.sprintf("%x",ord($1)).'}'/ge if $bytes > length;
++ return qq("$_") unless
+ /[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~]/; # fast exit
+
+ my $high = shift || "";
+@@ -719,6 +767,45 @@
+ # 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 +846,8 @@
+ 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 +865,7 @@
+ 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 +875,7 @@
+ 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 +927,21 @@
+
+ =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 replacement 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 replacement 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 +968,7 @@
+ 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 +1081,7 @@
+ $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 +1113,18 @@
+ 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 +1168,26 @@
+ 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 +1219,7 @@
+ $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 +1230,20 @@
+ 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 +1309,20 @@
+ 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']);
+@@ -1291,13 +1415,13 @@
+
+ Gurusamy Sarathy [email protected]
+
+-Copyright (c) 1996-98 Gurusamy Sarathy. All rights reserved.
++Copyright (c) 1996-2014 Gurusamy Sarathy. All rights reserved.
+ This program is free software; you can redistribute it and/or
+ modify it under the same terms as Perl itself.
+
+ =head1 VERSION
+
+-Version 2.125 (Aug 8 2009)
++Version 2.154 (September 18 2014)
+
+ =head1 SEE ALSO
+
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/Dumper.xs perl-5.12.5_dumper/dist/Data-Dumper/Dumper.xs
+--- perl-5.12.5/dist/Data-Dumper/Dumper.xs 2012-11-03 19:25:59.000000000 -0400
++++ perl-5.12.5_dumper/dist/Data-Dumper/Dumper.xs 2014-10-09 15:06:36.168048722 -0400
+@@ -12,22 +12,32 @@
+ # 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 esc_q_utf8 (pTHX_ SV *sv, const char *src, STRLEN slen, I32 do_utf8, I32 useqq);
++static bool globname_needs_quote(const char *s, STRLEN len);
++static bool key_needs_quote(const char *s, STRLEN len);
++static bool safe_decimal_number(const char *p, 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, I32 useqq, 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 +47,43 @@
+ # 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 */
+@@ -61,38 +93,95 @@
+ #define DD_is_integer(sv) SvIOK(sv)
+ #endif
+
+-/* does a string need to be protected? */
+-static I32
+-needs_quote(register const char *s)
++/* does a glob name need to be protected? */
++static bool
++globname_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;
++ return TRUE;
+ }
+ else
+- return 1;
++ return TRUE;
+ }
+ if (isIDFIRST(*s)) {
+- while (*++s)
+- if (!isALNUM(*s)) {
++ while (++s<send)
++ if (!isWORDCHAR(*s)) {
+ if (*s == ':')
+ goto TOP;
+ else
+- return 1;
++ return TRUE;
+ }
+ }
+ else
+- return 1;
+- return 0;
++ return TRUE;
++
++ return FALSE;
++}
++
++/* does a hash key need to be quoted (to the left of => ).
++ Previously this used (globname_)needs_quote() which accepted strings
++ like '::foo', but these aren't safe as unquoted keys under strict.
++*/
++static bool
++key_needs_quote(const char *s, STRLEN len) {
++ const char *send = s+len;
++
++ if (safe_decimal_number(s, len)) {
++ return FALSE;
++ }
++ else if (isIDFIRST(*s)) {
++ while (++s<send)
++ if (!isWORDCHAR(*s))
++ return TRUE;
++ }
++ else
++ return TRUE;
++
++ return FALSE;
++}
++
++/* Check that the SV can be represented as a simple decimal integer.
++ *
++ * The perl code does this by matching against /^(?:0|-?[1-9]\d{0,8})\z/
++*/
++static bool
++safe_decimal_number(const char *p, STRLEN len) {
++ if (len == 1 && *p == '0')
++ return TRUE;
++
++ if (len && *p == '-') {
++ ++p;
++ --len;
++ }
++
++ if (len == 0 || *p < '1' || *p > '9')
++ return FALSE;
++
++ ++p;
++ --len;
++
++ if (len > 8)
++ return FALSE;
++
++ while (len > 0) {
++ /* the perl code checks /\d/ but we don't want unicode digits here */
++ if (*p < '0' || *p > '9')
++ return FALSE;
++ ++p;
++ --len;
++ }
++ return TRUE;
+ }
+
+ /* 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 +197,9 @@
+ /* 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) {
+@@ -118,6 +207,7 @@
+ case '\\':
+ *d = '\\';
+ ++d; ++ret;
++ /* FALLTHROUGH */
+ default:
+ *d = *s;
+ ++d; ++s; --slen;
+@@ -127,8 +217,9 @@
+ return ret;
+ }
+
++/* this function is also misused for implementing $Useqq */
+ 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, I32 do_utf8, I32 useqq)
+ {
+ char *r, *rstart;
+ const char *s = src;
+@@ -142,10 +233,21 @@
+ STRLEN single_quotes = 0;
+ STRLEN qq_escapables = 0; /* " $ @ will need a \ in "" strings. */
+ STRLEN normal = 0;
++ int increment;
++ UV next;
+
+ /* 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; do_utf8 ? s += increment : s++) {
++ const UV k = do_utf8 ? utf8_to_uvchr_buf((U8*)s, (U8*) send, NULL) : *(U8*)s;
++
++ /* check for invalid utf8 */
++ increment = (k == 0 && *s != '\0') ? 1 : UTF8SKIP(s);
++
++ /* this is only used to check if the next character is an
++ * ASCII digit, which are invariant, so if the following collects
++ * a UTF-8 start byte it does no harm
++ */
++ next = (s + increment >= send ) ? 0 : *(U8*)(s+increment);
+
+ #ifdef EBCDIC
+ if (!isprint(k) || k > 256) {
+@@ -160,6 +262,17 @@
+ k <= 0xFFFFFFFF ? 8 : UVSIZE * 4
+ #endif
+ );
++#ifndef EBCDIC
++ } else if (useqq &&
++ /* we can't use the short form like '\0' if followed by a digit */
++ (((k >= 7 && k <= 10) || k == 12 || k == 13 || k == 27)
++ || (k < 8 && (next < '0' || next > '9')))) {
++ grow += 2;
++ } else if (useqq && k <= 31 && (next < '0' || next > '9')) {
++ grow += 3;
++ } else if (useqq && (k <= 31 || k >= 127)) {
++ grow += 4;
++#endif
+ } else if (k == '\\') {
+ backslashes++;
+ } else if (k == '\'') {
+@@ -170,7 +283,7 @@
+ normal++;
+ }
+ }
+- if (grow) {
++ if (grow || useqq) {
+ /* We have something needing hex. 3 is ""\0 */
+ sv_grow(sv, cur + 3 + grow + 2*backslashes + single_quotes
+ + 2*qq_escapables + normal);
+@@ -178,8 +291,8 @@
+
+ *r++ = '"';
+
+- for (s = src; s < send; s += UTF8SKIP(s)) {
+- const UV k = utf8_to_uvchr((U8*)s, NULL);
++ for (s = src; s < send; do_utf8 ? s += UTF8SKIP(s) : s++) {
++ const UV k = do_utf8 ? utf8_to_uvchr_buf((U8*)s, (U8*) send, NULL) : *(U8*)s;
+
+ if (k == '"' || k == '\\' || k == '$' || k == '@') {
+ *r++ = '\\';
+@@ -189,7 +302,44 @@
+ #ifdef EBCDIC
+ if (isprint(k) && k < 256)
+ #else
+- if (k < 0x80)
++ if (useqq && (k <= 31 || k == 127 || (!do_utf8 && k > 127))) {
++ bool next_is_digit;
++
++ *r++ = '\\';
++ switch (k) {
++ case 7: *r++ = 'a'; break;
++ case 8: *r++ = 'b'; break;
++ case 9: *r++ = 't'; break;
++ case 10: *r++ = 'n'; break;
++ case 12: *r++ = 'f'; break;
++ case 13: *r++ = 'r'; break;
++ case 27: *r++ = 'e'; break;
++ default:
++ increment = (k == 0 && *s != '\0') ? 1 : UTF8SKIP(s);
++
++ /* only ASCII digits matter here, which are invariant,
++ * since we only encode characters \377 and under, or
++ * \x177 and under for a unicode string
++ */
++ next = (s+increment < send) ? *(U8*)(s+increment) : 0;
++ next_is_digit = next >= '0' && next <= '9';
++
++ /* faster than
++ * r = r + my_sprintf(r, "%o", k);
++ */
++ if (k <= 7 && !next_is_digit) {
++ *r++ = (char)k + '0';
++ } else if (k <= 63 && !next_is_digit) {
++ *r++ = (char)(k>>3) + '0';
++ *r++ = (char)(k&7) + '0';
++ } else {
++ *r++ = (char)(k>>6) + '0';
++ *r++ = (char)((k&63)>>3) + '0';
++ *r++ = (char)(k&7) + '0';
++ }
++ }
++ }
++ else if (k < 0x80)
+ #endif
+ *r++ = (char)k;
+ else {
+@@ -229,7 +379,7 @@
+ sv_x(pTHX_ SV *sv, const char *str, STRLEN len, I32 n)
+ {
+ if (!sv)
+- sv = newSVpvn("", 0);
++ sv = newSVpvs("");
+ #ifdef DEBUGGING
+ else
+ assert(SvTYPE(sv) >= SVt_PV);
+@@ -262,10 +412,11 @@
+ 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, I32 useqq, IV maxrecurse)
+ {
+ char tmpbuf[128];
+- U32 i;
++ Size_t i;
+ char *c, *r, *realpack;
+ #ifdef DD_USE_OLD_ID_FORMAT
+ char id[128];
+@@ -289,7 +440,7 @@
+ 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 +463,7 @@
+ {
+ 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);
+@@ -347,13 +498,13 @@
+ SV *postentry;
+
+ if (realtype == SVt_PVHV)
+- sv_catpvn(retval, "{}", 2);
++ sv_catpvs(retval, "{}");
+ else if (realtype == SVt_PVAV)
+- sv_catpvn(retval, "[]", 2);
++ sv_catpvs(retval, "[]");
+ else
+- sv_catpvn(retval, "do{my $o}", 9);
++ sv_catpvs(retval, "do{my $o}");
+ postentry = newSVpvn(name, namelen);
+- sv_catpvn(postentry, " = ", 3);
++ sv_catpvs(postentry, " = ");
+ sv_catsv(postentry, othername);
+ av_push(postav, postentry);
+ }
+@@ -366,9 +517,9 @@
+ }
+ else {
+ sv_catpvn(retval, name, 1);
+- sv_catpvn(retval, "{", 1);
++ sv_catpvs(retval, "{");
+ sv_catsv(retval, othername);
+- sv_catpvn(retval, "}", 1);
++ sv_catpvs(retval, "}");
+ }
+ }
+ else
+@@ -388,11 +539,11 @@
+ else { /* store our name and continue */
+ SV *namesv;
+ if (name[0] == '@' || name[0] == '%') {
+- namesv = newSVpvn("\\", 1);
++ namesv = newSVpvs("\\");
+ sv_catpvn(namesv, name, namelen);
+ }
+ else if (realtype == SVt_PVCV && name[0] == '*') {
+- namesv = newSVpvn("\\", 2);
++ namesv = newSVpvs("\\");
+ sv_catpvn(namesv, name, namelen);
+ (SvPVX(namesv))[1] = '&';
+ }
+@@ -433,17 +584,21 @@
+ if (!purity && maxdepth > 0 && *levelp >= maxdepth) {
+ STRLEN vallen;
+ const char * const valstr = SvPV(val,vallen);
+- sv_catpvn(retval, "'", 1);
++ sv_catpvs(retval, "'");
+ sv_catpvn(retval, valstr, vallen);
+- sv_catpvn(retval, "'", 1);
++ sv_catpvs(retval, "'");
+ 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);
+ sv_catpvn(retval, blessstr, blesslen);
+- sv_catpvn(retval, "( ", 2);
++ sv_catpvs(retval, "( ");
+ if (indent >= 2) {
+ blesspad = apad;
+ apad = newSVsv(apad);
+@@ -457,18 +612,58 @@
+ if (is_regex)
+ {
+ STRLEN rlen;
+- const char *rval = SvPV(val, rlen);
+- const char *slash = strchr(rval, '/');
+- sv_catpvn(retval, "qr/", 3);
+- while (slash) {
++ SV *sv_pattern = NULL;
++ SV *sv_flags = NULL;
++ CV *re_pattern_cv;
++ const char *rval;
++ const char *rend;
++ const char *slash;
++
++ if ((re_pattern_cv = get_cv("re::regexp_pattern", 0))) {
++ dSP;
++ I32 count;
++ ENTER;
++ SAVETMPS;
++ PUSHMARK(SP);
++ XPUSHs(val);
++ PUTBACK;
++ count = call_sv((SV*)re_pattern_cv, G_ARRAY);
++ SPAGAIN;
++ if (count >= 2) {
++ sv_flags = POPs;
++ sv_pattern = POPs;
++ SvREFCNT_inc(sv_flags);
++ SvREFCNT_inc(sv_pattern);
++ }
++ PUTBACK;
++ FREETMPS;
++ LEAVE;
++ if (sv_pattern) {
++ sv_2mortal(sv_pattern);
++ sv_2mortal(sv_flags);
++ }
++ }
++ else {
++ sv_pattern = val;
++ }
++ assert(sv_pattern);
++ rval = SvPV(sv_pattern, rlen);
++ rend = rval+rlen;
++ slash = rval;
++ sv_catpvs(retval, "qr/");
++ for (;slash < rend; slash++) {
++ if (*slash == '\\') { ++slash; continue; }
++ if (*slash == '/') {
+ sv_catpvn(retval, rval, slash-rval);
+- sv_catpvn(retval, "\\/", 2);
++ sv_catpvs(retval, "\\/");
+ rlen -= slash-rval+1;
+ rval = slash+1;
+- slash = strchr(rval, '/');
++ }
+ }
+ sv_catpvn(retval, rval, rlen);
+- sv_catpvn(retval, "/", 1);
++ sv_catpvs(retval, "/");
++ if (sv_flags)
++ sv_catsv(retval, sv_flags);
+ }
+ else if (
+ #if PERL_VERSION < 9
+@@ -477,41 +672,44 @@
+ realtype <= SVt_PVMG
+ #endif
+ ) { /* scalar ref */
+- SV * const namesv = newSVpvn("${", 2);
++ SV * const namesv = newSVpvs("${");
+ sv_catpvn(namesv, name, namelen);
+- sv_catpvn(namesv, "}", 1);
++ sv_catpvs(namesv, "}");
+ if (realpack) { /* blessed */
+- sv_catpvn(retval, "do{\\(my $o = ", 13);
++ sv_catpvs(retval, "do{\\(my $o = ");
+ 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);
+- sv_catpvn(retval, ")}", 2);
++ maxdepth, sortkeys, use_sparse_seen_hash, useqq,
++ maxrecurse);
++ sv_catpvs(retval, ")}");
+ } /* plain */
+ else {
+- sv_catpvn(retval, "\\", 1);
++ sv_catpvs(retval, "\\");
+ 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, useqq,
++ maxrecurse);
+ }
+ SvREFCNT_dec(namesv);
+ }
+ else if (realtype == SVt_PVGV) { /* glob ref */
+- SV * const namesv = newSVpvn("*{", 2);
++ SV * const namesv = newSVpvs("*{");
+ sv_catpvn(namesv, name, namelen);
+- sv_catpvn(namesv, "}", 1);
+- sv_catpvn(retval, "\\", 1);
++ sv_catpvs(namesv, "}");
++ sv_catpvs(retval, "\\");
+ 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, useqq,
++ maxrecurse);
+ SvREFCNT_dec(namesv);
+ }
+ else if (realtype == SVt_PVAV) {
+ SV *totpad;
+- I32 ix = 0;
+- const I32 ixmax = av_len((AV *)ival);
++ SSize_t ix = 0;
++ const SSize_t ixmax = av_len((AV *)ival);
+
+ SV * const ixsv = newSViv(0);
+ /* allowing for a 24 char wide array index */
+@@ -519,11 +717,11 @@
+ (void)strcpy(iname, name);
+ inamelen = namelen;
+ if (name[0] == '@') {
+- sv_catpvn(retval, "(", 1);
++ sv_catpvs(retval, "(");
+ iname[0] = '$';
+ }
+ else {
+- sv_catpvn(retval, "[", 1);
++ sv_catpvs(retval, "[");
+ /* omit "->" in $foo{bar}->[0], but not in ${$foo}->[0] */
+ /*if (namelen > 0
+ && name[namelen-1] != ']' && name[namelen-1] != '}'
+@@ -570,7 +768,7 @@
+ if (indent >= 3) {
+ sv_catsv(retval, totpad);
+ sv_catsv(retval, ipad);
+- sv_catpvn(retval, "#", 1);
++ sv_catpvs(retval, "#");
+ sv_catsv(retval, ixsv);
+ }
+ sv_catsv(retval, totpad);
+@@ -578,9 +776,10 @@
+ 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,
++ useqq, maxrecurse);
+ if (ix < ixmax)
+- sv_catpvn(retval, ",", 1);
++ sv_catpvs(retval, ",");
+ }
+ if (ixmax >= 0) {
+ SV * const opad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), (*levelp)-1);
+@@ -589,9 +788,9 @@
+ SvREFCNT_dec(opad);
+ }
+ if (name[0] == '@')
+- sv_catpvn(retval, ")", 1);
++ sv_catpvs(retval, ")");
+ else
+- sv_catpvn(retval, "]", 1);
++ sv_catpvs(retval, "]");
+ SvREFCNT_dec(ixsv);
+ SvREFCNT_dec(totpad);
+ Safefree(iname);
+@@ -607,11 +806,11 @@
+
+ SV * const iname = newSVpvn(name, namelen);
+ if (name[0] == '%') {
+- sv_catpvn(retval, "(", 1);
++ sv_catpvs(retval, "(");
+ (SvPVX(iname))[0] = '$';
+ }
+ else {
+- sv_catpvn(retval, "{", 1);
++ sv_catpvs(retval, "{");
+ /* omit "->" in $foo[0]->{bar}, but not in ${$foo}->{bar} */
+ if ((namelen > 0
+ && name[namelen-1] != ']' && name[namelen-1] != '}')
+@@ -619,16 +818,16 @@
+ && (name[1] == '{'
+ || (name[0] == '\\' && name[2] == '{'))))
+ {
+- sv_catpvn(iname, "->", 2);
++ sv_catpvs(iname, "->");
+ }
+ }
+ if (name[0] == '*' && name[namelen-1] == '}' && namelen >= 8 &&
+ (instr(name+namelen-8, "{SCALAR}") ||
+ instr(name+namelen-7, "{ARRAY}") ||
+ instr(name+namelen-6, "{HASH}"))) {
+- sv_catpvn(iname, "->", 2);
++ sv_catpvs(iname, "->");
+ }
+- sv_catpvn(iname, "{", 1);
++ sv_catpvs(iname, "{");
+ totpad = newSVsv(sep);
+ sv_catsv(totpad, pad);
+ sv_catsv(totpad, apad);
+@@ -637,25 +836,34 @@
+ if (sortkeys) {
+ if (sortkeys == &PL_sv_yes) {
+ #if PERL_VERSION < 8
+- sortkeys = sv_2mortal(newSVpvn("Data::Dumper::_sortkeys", 23));
++ sortkeys = sv_2mortal(newSVpvs("Data::Dumper::_sortkeys"));
+ #else
+ keys = newAV();
+ (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
+- sortsv(AvARRAY(keys),
+- av_len(keys)+1,
+- IN_LOCALE ? Perl_sv_cmp_locale : Perl_sv_cmp);
+-# else
+- sortsv(AvARRAY(keys),
+- av_len(keys)+1,
+- Perl_sv_cmp);
++# ifdef USE_LOCALE_COLLATE
++# ifdef IN_LC /* Use this if available */
++ if (IN_LC(LC_COLLATE))
++# else
++ if (IN_LOCALE)
++# endif
++ {
++ sortsv(AvARRAY(keys),
++ av_len(keys)+1,
++ Perl_sv_cmp_locale);
++ }
++ else
+ # endif
+ #endif
++ {
++ sortsv(AvARRAY(keys),
++ av_len(keys)+1,
++ Perl_sv_cmp);
++ }
+ }
+ if (sortkeys != &PL_sv_yes) {
+ dSP; ENTER; SAVETMPS; PUSHMARK(sp);
+@@ -688,22 +896,22 @@
+ bool do_utf8 = FALSE;
+
+ if (sortkeys) {
+- if (!(keys && (I32)i <= av_len(keys))) break;
++ if (!(keys && (SSize_t)i <= av_len(keys))) break;
+ } else {
+ if (!(entry = hv_iternext((HV *)ival))) break;
+ }
+
+ if (i)
+- sv_catpvn(retval, ",", 1);
++ sv_catpvs(retval, ",");
+
+ 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);
+@@ -716,31 +924,27 @@
+
+ sv_catsv(retval, totpad);
+ sv_catsv(retval, ipad);
+- /* old logic was first to check utf8 flag, and if utf8 always
++ /* The (very)
++ old logic was first to check utf8 flag, and if utf8 always
+ call esc_q_utf8. This caused test to break under -Mutf8,
+ because there even strings like 'c' have utf8 flag on.
+ Hence with quotekeys == 0 the XS code would still '' quote
+ them based on flags, whereas the perl code would not,
+ based on regexps.
+- The perl code is correct.
+- needs_quote() decides that anything that isn't a valid
+- perl identifier needs to be quoted, hence only correctly
+- formed strings with no characters outside [A-Za-z0-9_:]
+- won't need quoting. None of those characters are used in
+- the byte encoding of utf8, so anything with utf8
+- encoded characters in will need quoting. Hence strings
+- with utf8 encoded characters in will end up inside do_utf8
+- just like before, but now strings with utf8 flag set but
+- only ascii characters will end up in the unquoted section.
+-
+- There should also be less tests for the (probably currently)
+- 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 (do_utf8) {
++
++ The old logic checked that the string was a valid
++ perl glob name (foo::bar), which isn't safe under
++ strict, and differs from the perl code which only
++ accepts simple identifiers.
++
++ With the fix for [perl #120384] I chose to make
++ their handling of key quoting compatible between XS
++ and perl.
++ */
++ if (quotekeys || key_needs_quote(key,keylen)) {
++ if (do_utf8 || useqq) {
+ STRLEN ocur = SvCUR(retval);
+- nlen = esc_q_utf8(aTHX_ retval, key, klen);
++ nlen = esc_q_utf8(aTHX_ retval, key, klen, do_utf8, useqq);
+ nkey = SvPVX(retval) + ocur;
+ }
+ else {
+@@ -765,7 +969,7 @@
+ }
+ sname = newSVsv(iname);
+ sv_catpvn(sname, nkey, nlen);
+- sv_catpvn(sname, "}", 1);
++ sv_catpvs(sname, "}");
+
+ sv_catsv(retval, pair);
+ if (indent >= 2) {
+@@ -785,7 +989,8 @@
+ 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, useqq,
++ maxrecurse);
+ SvREFCNT_dec(sname);
+ Safefree(nkey_buffer);
+ if (indent >= 2)
+@@ -798,19 +1003,19 @@
+ SvREFCNT_dec(opad);
+ }
+ if (name[0] == '%')
+- sv_catpvn(retval, ")", 1);
++ sv_catpvs(retval, ")");
+ else
+- sv_catpvn(retval, "}", 1);
++ sv_catpvs(retval, "}");
+ SvREFCNT_dec(iname);
+ SvREFCNT_dec(totpad);
+ }
+ else if (realtype == SVt_PVCV) {
+- sv_catpvn(retval, "sub { \"DUMMY\" }", 15);
++ sv_catpvs(retval, "sub { \"DUMMY\" }");
+ if (purity)
+ 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 */
+@@ -821,7 +1026,7 @@
+ SvREFCNT_dec(apad);
+ apad = blesspad;
+ }
+- sv_catpvn(retval, ", '", 3);
++ sv_catpvs(retval, ", '");
+
+ plen = strlen(realpack);
+ pticks = num_q(realpack, plen);
+@@ -840,11 +1045,11 @@
+ else {
+ sv_catpvn(retval, realpack, strlen(realpack));
+ }
+- sv_catpvn(retval, "' )", 3);
++ sv_catpvs(retval, "' )");
+ if (toaster && SvPOK(toaster) && SvCUR(toaster)) {
+- sv_catpvn(retval, "->", 2);
++ sv_catpvs(retval, "->");
+ sv_catsv(retval, toaster);
+- sv_catpvn(retval, "()", 2);
++ sv_catpvs(retval, "()");
+ }
+ }
+ SvREFCNT_dec(ipad);
+@@ -852,6 +1057,7 @@
+ }
+ else {
+ STRLEN i;
++ const MAGIC *mg;
+
+ if (namelen) {
+ #ifdef DD_USE_OLD_ID_FORMAT
+@@ -868,14 +1074,21 @@
+ if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp)
+ && (svp = av_fetch(seenentry, 2, FALSE)) && *svp && SvIV(*svp) > 0)
+ {
+- sv_catpvn(retval, "${", 2);
++ sv_catpvs(retval, "${");
+ sv_catsv(retval, othername);
+- sv_catpvn(retval, "}", 1);
++ sv_catpvs(retval, "}");
+ return 1;
+ }
+ }
+- else if (val != &PL_sv_undef) {
+- SV * const namesv = newSVpvn("\\", 1);
++ /* 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 = newSVpvs("\\");
+ sv_catpvn(namesv, name, namelen);
+ seenentry = newAV();
+ av_push(seenentry, namesv);
+@@ -909,12 +1122,32 @@
+ }
+ 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 (globname_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, 1, useqq);
++ 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 +1155,7 @@
+ i += 3;
+ r[i++] = '\''; r[i++] = '}';
+ r[i] = '\0';
++ }
+ }
+ else {
+ sv_grow(retval, SvCUR(retval)+i+2);
+@@ -935,8 +1169,8 @@
+ static const char* const entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
+ static const STRLEN sizes[] = { 8, 7, 6 };
+ SV *e;
+- SV * const nname = newSVpvn("", 0);
+- SV * const newapad = newSVpvn("", 0);
++ SV * const nname = newSVpvs("");
++ SV * const newapad = newSVpvs("");
+ GV * const gv = (GV*)val;
+ I32 j;
+
+@@ -953,7 +1187,7 @@
+
+ sv_setsv(nname, postentry);
+ sv_catpvn(nname, entries[j], sizes[j]);
+- sv_catpvn(postentry, " = ", 3);
++ sv_catpvs(postentry, " = ");
+ av_push(postav, postentry);
+ e = newRV_inc(e);
+
+@@ -965,7 +1199,8 @@
+ seenhv, postav, &nlevel, indent, pad, xpad,
+ newapad, sep, pair, freezer, toaster, purity,
+ deepcopy, quotekeys, bless, maxdepth,
+- sortkeys);
++ sortkeys, use_sparse_seen_hash, useqq,
++ maxrecurse);
+ SvREFCNT_dec(e);
+ }
+ }
+@@ -975,13 +1210,36 @@
+ }
+ }
+ else if (val == &PL_sv_undef || !SvOK(val)) {
+- sv_catpvn(retval, "undef", 5);
++ sv_catpvs(retval, "undef");
+ }
++#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);
+- if (DO_UTF8(val))
+- i += esc_q_utf8(aTHX_ retval, c, i);
++ c = SvPV(val, i);
++ /* the pure perl and XS non-qq outputs have historically been
++ * different in this case, but for useqq, let's try to match
++ * the pure perl code.
++ * see [perl #74798]
++ */
++ if (useqq && safe_decimal_number(c, i)) {
++ sv_catsv(retval, val);
++ }
++ else if (DO_UTF8(val) || useqq)
++ i += esc_q_utf8(aTHX_ retval, c, i, DO_UTF8(val), useqq);
+ else {
+ sv_grow(retval, SvCUR(retval)+3+2*i); /* 3: ""\0 */
+ r = SvPVX(retval) + SvCUR(retval);
+@@ -1012,7 +1270,7 @@
+ #
+ # 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 deparse yet.'
+ #
+
+ void
+@@ -1026,13 +1284,16 @@
+ HV *seenhv = NULL;
+ AV *postav, *todumpav, *namesav;
+ I32 level = 0;
+- I32 indent, terse, i, imax, postlen;
++ I32 indent, terse, useqq;
++ SSize_t i, imax, postlen;
+ SV **svp;
+ 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 +1303,11 @@
+ 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;
+@@ -1065,16 +1327,20 @@
+ = freezer = toaster = bless = sortkeys = &PL_sv_undef;
+ name = sv_newmortal();
+ indent = 2;
+- terse = purity = deepcopy = 0;
++ terse = purity = deepcopy = useqq = 0;
+ quotekeys = 1;
+
+- retval = newSVpvn("", 0);
++ retval = newSVpvs("");
+ if (SvROK(href)
+ && (hv = (HV*)SvRV((SV*)href))
+ && SvTYPE(hv) == SVt_PVHV) {
+
+ 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))
+@@ -1085,10 +1351,8 @@
+ purity = SvIV(*svp);
+ if ((svp = hv_fetch(hv, "terse", 5, FALSE)))
+ terse = SvTRUE(*svp);
+-#if 0 /* useqq currently unused */
+ if ((svp = hv_fetch(hv, "useqq", 5, FALSE)))
+ useqq = SvTRUE(*svp);
+-#endif
+ if ((svp = hv_fetch(hv, "pad", 3, FALSE)))
+ pad = *svp;
+ if ((svp = hv_fetch(hv, "xpad", 4, FALSE)))
+@@ -1113,6 +1377,8 @@
+ 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))
+@@ -1130,7 +1396,7 @@
+ imax = av_len(todumpav);
+ else
+ imax = -1;
+- valstr = newSVpvn("",0);
++ valstr = newSVpvs("");
+ for (i = 0; i <= imax; ++i) {
+ SV *newapad;
+
+@@ -1179,7 +1445,7 @@
+ 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,25 +1454,28 @@
+ 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,
++ useqq, maxrecurse);
++ SPAGAIN;
+
+- if (indent >= 2)
++ if (indent >= 2 && !terse)
+ SvREFCNT_dec(newapad);
+
+ postlen = av_len(postav);
+ if (postlen >= 0 || !terse) {
+ sv_insert(valstr, 0, 0, " = ", 3);
+ sv_insert(valstr, 0, 0, SvPVX_const(name), SvCUR(name));
+- sv_catpvn(valstr, ";", 1);
++ sv_catpvs(valstr, ";");
+ }
+ sv_catsv(retval, pad);
+ sv_catsv(retval, valstr);
+ sv_catsv(retval, sep);
+ if (postlen >= 0) {
+- I32 i;
++ SSize_t i;
+ sv_catsv(retval, pad);
+ for (i = 0; i <= postlen; ++i) {
+ SV *elem;
+@@ -1214,20 +1483,20 @@
+ if (svp && (elem = *svp)) {
+ sv_catsv(retval, elem);
+ if (i < postlen) {
+- sv_catpvn(retval, ";", 1);
++ sv_catpvs(retval, ";");
+ sv_catsv(retval, sep);
+ sv_catsv(retval, pad);
+ }
+ }
+ }
+- sv_catpvn(retval, ";", 1);
++ sv_catpvs(retval, ";");
+ sv_catsv(retval, sep);
+ }
+ sv_setpvn(valstr, "", 0);
+ if (gimme == G_ARRAY) {
+ XPUSHs(sv_2mortal(retval));
+ if (i < imax) /* not the last time thro ? */
+- retval = newSVpvn("",0);
++ retval = newSVpvs("");
+ }
+ }
+ SvREFCNT_dec(postav);
+@@ -1238,3 +1507,21 @@
+ 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 -ur --new-file perl-5.12.5/dist/Data-Dumper/Makefile.PL perl-5.12.5_dumper/dist/Data-Dumper/Makefile.PL
+--- perl-5.12.5/dist/Data-Dumper/Makefile.PL 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/Makefile.PL 2014-10-09 15:06:36.168520426 -0400
+@@ -0,0 +1,25 @@
++use 5.006001;
++use ExtUtils::MakeMaker;
++WriteMakefile(
++ NAME => "Data::Dumper",
++ VERSION_FROM => 'Dumper.pm',
++ 'dist' => {
++ COMPRESS => 'gzip -9f',
++ SUFFIX => 'gz',
++ DIST_DEFAULT => 'all tardist',
++ },
++ MAN3PODS => {},
++ DEFINE => '-DUSE_PPPORT_H',
++ INSTALLDIRS => 'perl',
++ BUILD_REQUIRES => {
++ Test::More => '0.98',
++ },
++ META_MERGE => {
++ dynamic_config => 0,
++ resources => {
++ repository => 'git://perl5.git.perl.org/perl.git perl-git',
++ bugtracker => 'http://rt.perl.org/perlbug/',
++ MailingList => 'http://lists.cpan.org/showlist.cgi?name=perl5-porters'
++ },
++ }
++);
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/MANIFEST perl-5.12.5_dumper/dist/Data-Dumper/MANIFEST
+--- perl-5.12.5/dist/Data-Dumper/MANIFEST 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/MANIFEST 2014-10-09 15:06:36.168906933 -0400
+@@ -0,0 +1,34 @@
++Changes
++Dumper.pm
++Dumper.xs
++Makefile.PL
++MANIFEST This list of files
++MANIFEST.SKIP
++ppport.h
++t/bless.t
++t/bless_var_method.t
++t/bugs.t
++t/deparse.t
++t/dumper.t
++t/dumpperl.t
++t/freezer.t
++t/freezer_useperl.t
++t/indent.t
++t/lib/Testing.pm
++t/misc.t
++t/names.t
++t/overload.t
++t/pair.t
++t/perl-74170.t
++t/purity_deepcopy_maxdepth.t
++t/qr.t
++t/quotekeys.t
++t/recurse.t
++t/seen.t
++t/sortkeys.t
++t/sparseseen.t
++t/terse.t
++t/toaster.t
++t/values.t
++Todo
++META.yml Module meta-data (added by MakeMaker)
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/MANIFEST.SKIP perl-5.12.5_dumper/dist/Data-Dumper/MANIFEST.SKIP
+--- perl-5.12.5/dist/Data-Dumper/MANIFEST.SKIP 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/MANIFEST.SKIP 2014-10-09 15:06:36.169255091 -0400
+@@ -0,0 +1,33 @@
++Dumper\.bs$
++Dumper\.c$
++\.o$
++\.git/
++\.gitignore$
++\b(?:MY)?META\.(?:json|yml)$
++
++# Default section:
++# Avoid version control files.
++\bRCS\b
++\bCVS\b
++,v$
++\B\.svn\b
++
++# Avoid Makemaker generated and utility files.
++\bMakefile$
++\bblib
++\bMakeMaker-\d
++\bpm_to_blib$
++\bblibdirs$
++
++# Avoid Module::Build generated and utility files.
++\bBuild$
++\b_build
++
++# Avoid temp and backup files.
++~$
++\.tmp$
++\.old$
++\.bak$
++\#$
++\b\.#
++\b\..*\.sw[op]$
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/META.yml perl-5.12.5_dumper/dist/Data-Dumper/META.yml
+--- perl-5.12.5/dist/Data-Dumper/META.yml 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/META.yml 2014-10-09 15:06:36.169646557 -0400
+@@ -0,0 +1,25 @@
++--- #YAML:1.0
++name: Data-Dumper
++version: 2.154
++abstract: ~
++author: []
++license: unknown
++distribution_type: module
++configure_requires:
++ ExtUtils::MakeMaker: 0
++build_requires:
++ Test::More: 0.98
++requires: {}
++resources:
++ bugtracker: http://rt.perl.org/perlbug/
++ MailingList: http://lists.cpan.org/showlist.cgi?name=perl5-porters
++ repository: git://perl5.git.perl.org/perl.git perl-git
++no_index:
++ directory:
++ - t
++ - inc
++generated_by: ExtUtils::MakeMaker version 6.57_05
++meta-spec:
++ url: http://module-build.sourceforge.net/META-spec-v1.4.html
++ version: 1.4
++dynamic_config: 0
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/ppport.h perl-5.12.5_dumper/dist/Data-Dumper/ppport.h
+--- perl-5.12.5/dist/Data-Dumper/ppport.h 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/ppport.h 2014-10-09 15:06:36.171549607 -0400
+@@ -0,0 +1,7452 @@
++#if 0
++<<'SKIP';
++#endif
++/*
++----------------------------------------------------------------------
++
++ ppport.h -- Perl/Pollution/Portability Version 3.21
++
++ Automatically created by Devel::PPPort running under perl 5.014002.
++
++ Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
++ includes in parts/inc/ instead.
++
++ Use 'perldoc ppport.h' to view the documentation below.
++
++----------------------------------------------------------------------
++
++SKIP
++
++=pod
++
++=head1 NAME
++
++ppport.h - Perl/Pollution/Portability version 3.21
++
++=head1 SYNOPSIS
++
++ perl ppport.h [options] [source files]
++
++ Searches current directory for files if no [source files] are given
++
++ --help show short help
++
++ --version show version
++
++ --patch=file write one patch file with changes
++ --copy=suffix write changed copies with suffix
++ --diff=program use diff program and options
++
++ --compat-version=version provide compatibility with Perl version
++ --cplusplus accept C++ comments
++
++ --quiet don't output anything except fatal errors
++ --nodiag don't show diagnostics
++ --nohints don't show hints
++ --nochanges don't suggest changes
++ --nofilter don't filter input files
++
++ --strip strip all script and doc functionality from
++ ppport.h
++
++ --list-provided list provided API
++ --list-unsupported list unsupported API
++ --api-info=name show Perl API portability information
++
++=head1 COMPATIBILITY
++
++This version of F<ppport.h> is designed to support operation with Perl
++installations back to 5.003, and has been tested up to 5.11.5.
++
++=head1 OPTIONS
++
++=head2 --help
++
++Display a brief usage summary.
++
++=head2 --version
++
++Display the version of F<ppport.h>.
++
++=head2 --patch=I<file>
++
++If this option is given, a single patch file will be created if
++any changes are suggested. This requires a working diff program
++to be installed on your system.
++
++=head2 --copy=I<suffix>
++
++If this option is given, a copy of each file will be saved with
++the given suffix that contains the suggested changes. This does
++not require any external programs. Note that this does not
++automagially add a dot between the original filename and the
++suffix. If you want the dot, you have to include it in the option
++argument.
++
++If neither C<--patch> or C<--copy> are given, the default is to
++simply print the diffs for each file. This requires either
++C<Text::Diff> or a C<diff> program to be installed.
++
++=head2 --diff=I<program>
++
++Manually set the diff program and options to use. The default
++is to use C<Text::Diff>, when installed, and output unified
++context diffs.
++
++=head2 --compat-version=I<version>
++
++Tell F<ppport.h> to check for compatibility with the given
++Perl version. The default is to check for compatibility with Perl
++version 5.003. You can use this option to reduce the output
++of F<ppport.h> if you intend to be backward compatible only
++down to a certain Perl version.
++
++=head2 --cplusplus
++
++Usually, F<ppport.h> will detect C++ style comments and
++replace them with C style comments for portability reasons.
++Using this option instructs F<ppport.h> to leave C++
++comments untouched.
++
++=head2 --quiet
++
++Be quiet. Don't print anything except fatal errors.
++
++=head2 --nodiag
++
++Don't output any diagnostic messages. Only portability
++alerts will be printed.
++
++=head2 --nohints
++
++Don't output any hints. Hints often contain useful portability
++notes. Warnings will still be displayed.
++
++=head2 --nochanges
++
++Don't suggest any changes. Only give diagnostic output and hints
++unless these are also deactivated.
++
++=head2 --nofilter
++
++Don't filter the list of input files. By default, files not looking
++like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
++
++=head2 --strip
++
++Strip all script and documentation functionality from F<ppport.h>.
++This reduces the size of F<ppport.h> dramatically and may be useful
++if you want to include F<ppport.h> in smaller modules without
++increasing their distribution size too much.
++
++The stripped F<ppport.h> will have a C<--unstrip> option that allows
++you to undo the stripping, but only if an appropriate C<Devel::PPPort>
++module is installed.
++
++=head2 --list-provided
++
++Lists the API elements for which compatibility is provided by
++F<ppport.h>. Also lists if it must be explicitly requested,
++if it has dependencies, and if there are hints or warnings for it.
++
++=head2 --list-unsupported
++
++Lists the API elements that are known not to be supported by
++F<ppport.h> and below which version of Perl they probably
++won't be available or work.
++
++=head2 --api-info=I<name>
++
++Show portability information for API elements matching I<name>.
++If I<name> is surrounded by slashes, it is interpreted as a regular
++expression.
++
++=head1 DESCRIPTION
++
++In order for a Perl extension (XS) module to be as portable as possible
++across differing versions of Perl itself, certain steps need to be taken.
++
++=over 4
++
++=item *
++
++Including this header is the first major one. This alone will give you
++access to a large part of the Perl API that hasn't been available in
++earlier Perl releases. Use
++
++ perl ppport.h --list-provided
++
++to see which API elements are provided by ppport.h.
++
++=item *
++
++You should avoid using deprecated parts of the API. For example, using
++global Perl variables without the C<PL_> prefix is deprecated. Also,
++some API functions used to have a C<perl_> prefix. Using this form is
++also deprecated. You can safely use the supported API, as F<ppport.h>
++will provide wrappers for older Perl versions.
++
++=item *
++
++If you use one of a few functions or variables that were not present in
++earlier versions of Perl, and that can't be provided using a macro, you
++have to explicitly request support for these functions by adding one or
++more C<#define>s in your source code before the inclusion of F<ppport.h>.
++
++These functions or variables will be marked C<explicit> in the list shown
++by C<--list-provided>.
++
++Depending on whether you module has a single or multiple files that
++use such functions or variables, you want either C<static> or global
++variants.
++
++For a C<static> function or variable (used only in a single source
++file), use:
++
++ #define NEED_function
++ #define NEED_variable
++
++For a global function or variable (used in multiple source files),
++use:
++
++ #define NEED_function_GLOBAL
++ #define NEED_variable_GLOBAL
++
++Note that you mustn't have more than one global request for the
++same function or variable in your project.
++
++ Function / Variable Static Request Global Request
++ -----------------------------------------------------------------------------------------
++ PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL
++ PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
++ eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
++ grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
++ grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
++ grok_number() NEED_grok_number NEED_grok_number_GLOBAL
++ grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
++ grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
++ load_module() NEED_load_module NEED_load_module_GLOBAL
++ my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
++ my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
++ my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
++ my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
++ newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
++ newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
++ newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
++ newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
++ newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
++ pv_display() NEED_pv_display NEED_pv_display_GLOBAL
++ pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
++ pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
++ sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
++ sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
++ sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
++ sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
++ sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
++ sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
++ sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
++ vload_module() NEED_vload_module NEED_vload_module_GLOBAL
++ vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
++ warner() NEED_warner NEED_warner_GLOBAL
++
++To avoid namespace conflicts, you can change the namespace of the
++explicitly exported functions / variables using the C<DPPP_NAMESPACE>
++macro. Just C<#define> the macro before including C<ppport.h>:
++
++ #define DPPP_NAMESPACE MyOwnNamespace_
++ #include "ppport.h"
++
++The default namespace is C<DPPP_>.
++
++=back
++
++The good thing is that most of the above can be checked by running
++F<ppport.h> on your source code. See the next section for
++details.
++
++=head1 EXAMPLES
++
++To verify whether F<ppport.h> is needed for your module, whether you
++should make any changes to your code, and whether any special defines
++should be used, F<ppport.h> can be run as a Perl script to check your
++source code. Simply say:
++
++ perl ppport.h
++
++The result will usually be a list of patches suggesting changes
++that should at least be acceptable, if not necessarily the most
++efficient solution, or a fix for all possible problems.
++
++If you know that your XS module uses features only available in
++newer Perl releases, if you're aware that it uses C++ comments,
++and if you want all suggestions as a single patch file, you could
++use something like this:
++
++ perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
++
++If you only want your code to be scanned without any suggestions
++for changes, use:
++
++ perl ppport.h --nochanges
++
++You can specify a different C<diff> program or options, using
++the C<--diff> option:
++
++ perl ppport.h --diff='diff -C 10'
++
++This would output context diffs with 10 lines of context.
++
++If you want to create patched copies of your files instead, use:
++
++ perl ppport.h --copy=.new
++
++To display portability information for the C<newSVpvn> function,
++use:
++
++ perl ppport.h --api-info=newSVpvn
++
++Since the argument to C<--api-info> can be a regular expression,
++you can use
++
++ perl ppport.h --api-info=/_nomg$/
++
++to display portability information for all C<_nomg> functions or
++
++ perl ppport.h --api-info=/./
++
++to display information for all known API elements.
++
++=head1 BUGS
++
++If this version of F<ppport.h> is causing failure during
++the compilation of this module, please check if newer versions
++of either this module or C<Devel::PPPort> are available on CPAN
++before sending a bug report.
++
++If F<ppport.h> was generated using the latest version of
++C<Devel::PPPort> and is causing failure of this module, please
++file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
++
++Please include the following information:
++
++=over 4
++
++=item 1.
++
++The complete output from running "perl -V"
++
++=item 2.
++
++This file.
++
++=item 3.
++
++The name and version of the module you were trying to build.
++
++=item 4.
++
++A full log of the build that failed.
++
++=item 5.
++
++Any other information that you think could be relevant.
++
++=back
++
++For the latest version of this code, please get the C<Devel::PPPort>
++module from CPAN.
++
++=head1 COPYRIGHT
++
++Version 3.x, Copyright (c) 2004-2013, Marcus Holland-Moritz.
++
++Version 2.x, Copyright (C) 2001, Paul Marquess.
++
++Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
++
++This program is free software; you can redistribute it and/or
++modify it under the same terms as Perl itself.
++
++=head1 SEE ALSO
++
++See L<Devel::PPPort>.
++
++=cut
++
++use strict;
++
++# Disable broken TRIE-optimization
++BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
++
++my $VERSION = 3.21;
++
++my %opt = (
++ quiet => 0,
++ diag => 1,
++ hints => 1,
++ changes => 1,
++ cplusplus => 0,
++ filter => 1,
++ strip => 0,
++ version => 0,
++);
++
++my($ppport) = $0 =~ /([\w.]+)$/;
++my $LF = '(?:\r\n|[\r\n])'; # line feed
++my $HS = "[ \t]"; # horizontal whitespace
++
++# Never use C comments in this file!
++my $ccs = '/'.'*';
++my $cce = '*'.'/';
++my $rccs = quotemeta $ccs;
++my $rcce = quotemeta $cce;
++
++eval {
++ require Getopt::Long;
++ Getopt::Long::GetOptions(\%opt, qw(
++ help quiet diag! filter! hints! changes! cplusplus strip version
++ patch=s copy=s diff=s compat-version=s
++ list-provided list-unsupported api-info=s
++ )) or usage();
++};
++
++if ($@ and grep /^-/, @ARGV) {
++ usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
++ die "Getopt::Long not found. Please don't use any options.\n";
++}
++
++if ($opt{version}) {
++ print "This is $0 $VERSION.\n";
++ exit 0;
++}
++
++usage() if $opt{help};
++strip() if $opt{strip};
++
++if (exists $opt{'compat-version'}) {
++ my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
++ if ($@) {
++ die "Invalid version number format: '$opt{'compat-version'}'\n";
++ }
++ die "Only Perl 5 is supported\n" if $r != 5;
++ die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
++ $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
++}
++else {
++ $opt{'compat-version'} = 5;
++}
++
++my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
++ ? ( $1 => {
++ ($2 ? ( base => $2 ) : ()),
++ ($3 ? ( todo => $3 ) : ()),
++ (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
++ (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
++ (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
++ } )
++ : die "invalid spec: $_" } qw(
++AvFILLp|5.004050||p
++AvFILL|||
++BhkDISABLE||5.019003|
++BhkENABLE||5.019003|
++BhkENTRY_set||5.019003|
++BhkENTRY|||
++BhkFLAGS|||
++CALL_BLOCK_HOOKS|||
++CLASS|||n
++CPERLscope|5.005000||p
++CX_CURPAD_SAVE|||
++CX_CURPAD_SV|||
++CopFILEAV|5.006000||p
++CopFILEGV_set|5.006000||p
++CopFILEGV|5.006000||p
++CopFILESV|5.006000||p
++CopFILE_set|5.006000||p
++CopFILE|5.006000||p
++CopSTASHPV_set|5.006000||p
++CopSTASHPV|5.006000||p
++CopSTASH_eq|5.006000||p
++CopSTASH_set|5.006000||p
++CopSTASH|5.006000||p
++CopyD|5.009002|5.004050|p
++Copy||5.004050|
++CvPADLIST||5.008001|
++CvSTASH|||
++CvWEAKOUTSIDE|||
++DEFSV_set|5.010001||p
++DEFSV|5.004050||p
++END_EXTERN_C|5.005000||p
++ENTER|||
++ERRSV|5.004050||p
++EXTEND|||
++EXTERN_C|5.005000||p
++F0convert|||n
++FREETMPS|||
++GIMME_V||5.004000|n
++GIMME|||n
++GROK_NUMERIC_RADIX|5.007002||p
++G_ARRAY|||
++G_DISCARD|||
++G_EVAL|||
++G_METHOD|5.006001||p
++G_NOARGS|||
++G_SCALAR|||
++G_VOID||5.004000|
++GetVars|||
++GvAV|||
++GvCV|||
++GvHV|||
++GvSVn|5.009003||p
++GvSV|||
++Gv_AMupdate||5.011000|
++HEf_SVKEY||5.004000|
++HeHASH||5.004000|
++HeKEY||5.004000|
++HeKLEN||5.004000|
++HePV||5.004000|
++HeSVKEY_force||5.004000|
++HeSVKEY_set||5.004000|
++HeSVKEY||5.004000|
++HeUTF8||5.010001|
++HeVAL||5.004000|
++HvENAMELEN||5.015004|
++HvENAMEUTF8||5.015004|
++HvENAME||5.013007|
++HvNAMELEN_get|5.009003||p
++HvNAMELEN||5.015004|
++HvNAMEUTF8||5.015004|
++HvNAME_get|5.009003||p
++HvNAME|||
++INT2PTR|5.006000||p
++IN_LOCALE_COMPILETIME|5.007002||p
++IN_LOCALE_RUNTIME|5.007002||p
++IN_LOCALE|5.007002||p
++IN_PERL_COMPILETIME|5.008001||p
++IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
++IS_NUMBER_INFINITY|5.007002||p
++IS_NUMBER_IN_UV|5.007002||p
++IS_NUMBER_NAN|5.007003||p
++IS_NUMBER_NEG|5.007002||p
++IS_NUMBER_NOT_INT|5.007002||p
++IVSIZE|5.006000||p
++IVTYPE|5.006000||p
++IVdf|5.006000||p
++LEAVE|||
++LINKLIST||5.013006|
++LVRET|||
++MARK|||
++MULTICALL||5.019003|
++MY_CXT_CLONE|5.009002||p
++MY_CXT_INIT|5.007003||p
++MY_CXT|5.007003||p
++MoveD|5.009002|5.004050|p
++Move||5.004050|
++NOOP|5.005000||p
++NUM2PTR|5.006000||p
++NVTYPE|5.006000||p
++NVef|5.006001||p
++NVff|5.006001||p
++NVgf|5.006001||p
++Newxc|5.009003||p
++Newxz|5.009003||p
++Newx|5.009003||p
++Nullav|||
++Nullch|||
++Nullcv|||
++Nullhv|||
++Nullsv|||
++OP_CLASS||5.013007|
++OP_DESC||5.007003|
++OP_NAME||5.007003|
++ORIGMARK|||
++PAD_BASE_SV|||
++PAD_CLONE_VARS|||
++PAD_COMPNAME_FLAGS|||
++PAD_COMPNAME_GEN_set|||
++PAD_COMPNAME_GEN|||
++PAD_COMPNAME_OURSTASH|||
++PAD_COMPNAME_PV|||
++PAD_COMPNAME_TYPE|||
++PAD_RESTORE_LOCAL|||
++PAD_SAVE_LOCAL|||
++PAD_SAVE_SETNULLPAD|||
++PAD_SETSV|||
++PAD_SET_CUR_NOSAVE|||
++PAD_SET_CUR|||
++PAD_SVl|||
++PAD_SV|||
++PERLIO_FUNCS_CAST|5.009003||p
++PERLIO_FUNCS_DECL|5.009003||p
++PERL_ABS|5.008001||p
++PERL_BCDVERSION|5.019002||p
++PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
++PERL_HASH|5.004000||p
++PERL_INT_MAX|5.004000||p
++PERL_INT_MIN|5.004000||p
++PERL_LONG_MAX|5.004000||p
++PERL_LONG_MIN|5.004000||p
++PERL_MAGIC_arylen|5.007002||p
++PERL_MAGIC_backref|5.007002||p
++PERL_MAGIC_bm|5.007002||p
++PERL_MAGIC_collxfrm|5.007002||p
++PERL_MAGIC_dbfile|5.007002||p
++PERL_MAGIC_dbline|5.007002||p
++PERL_MAGIC_defelem|5.007002||p
++PERL_MAGIC_envelem|5.007002||p
++PERL_MAGIC_env|5.007002||p
++PERL_MAGIC_ext|5.007002||p
++PERL_MAGIC_fm|5.007002||p
++PERL_MAGIC_glob|5.019002||p
++PERL_MAGIC_isaelem|5.007002||p
++PERL_MAGIC_isa|5.007002||p
++PERL_MAGIC_mutex|5.019002||p
++PERL_MAGIC_nkeys|5.007002||p
++PERL_MAGIC_overload_elem|5.019002||p
++PERL_MAGIC_overload_table|5.007002||p
++PERL_MAGIC_overload|5.019002||p
++PERL_MAGIC_pos|5.007002||p
++PERL_MAGIC_qr|5.007002||p
++PERL_MAGIC_regdata|5.007002||p
++PERL_MAGIC_regdatum|5.007002||p
++PERL_MAGIC_regex_global|5.007002||p
++PERL_MAGIC_shared_scalar|5.007003||p
++PERL_MAGIC_shared|5.007003||p
++PERL_MAGIC_sigelem|5.007002||p
++PERL_MAGIC_sig|5.007002||p
++PERL_MAGIC_substr|5.007002||p
++PERL_MAGIC_sv|5.007002||p
++PERL_MAGIC_taint|5.007002||p
++PERL_MAGIC_tiedelem|5.007002||p
++PERL_MAGIC_tiedscalar|5.007002||p
++PERL_MAGIC_tied|5.007002||p
++PERL_MAGIC_utf8|5.008001||p
++PERL_MAGIC_uvar_elem|5.007003||p
++PERL_MAGIC_uvar|5.007002||p
++PERL_MAGIC_vec|5.007002||p
++PERL_MAGIC_vstring|5.008001||p
++PERL_PV_ESCAPE_ALL|5.009004||p
++PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
++PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
++PERL_PV_ESCAPE_NOCLEAR|5.009004||p
++PERL_PV_ESCAPE_QUOTE|5.009004||p
++PERL_PV_ESCAPE_RE|5.009005||p
++PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
++PERL_PV_ESCAPE_UNI|5.009004||p
++PERL_PV_PRETTY_DUMP|5.009004||p
++PERL_PV_PRETTY_ELLIPSES|5.010000||p
++PERL_PV_PRETTY_LTGT|5.009004||p
++PERL_PV_PRETTY_NOCLEAR|5.010000||p
++PERL_PV_PRETTY_QUOTE|5.009004||p
++PERL_PV_PRETTY_REGPROP|5.009004||p
++PERL_QUAD_MAX|5.004000||p
++PERL_QUAD_MIN|5.004000||p
++PERL_REVISION|5.006000||p
++PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
++PERL_SCAN_DISALLOW_PREFIX|5.007003||p
++PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
++PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
++PERL_SHORT_MAX|5.004000||p
++PERL_SHORT_MIN|5.004000||p
++PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
++PERL_SUBVERSION|5.006000||p
++PERL_SYS_INIT3||5.010000|
++PERL_SYS_INIT||5.010000|
++PERL_SYS_TERM||5.019003|
++PERL_UCHAR_MAX|5.004000||p
++PERL_UCHAR_MIN|5.004000||p
++PERL_UINT_MAX|5.004000||p
++PERL_UINT_MIN|5.004000||p
++PERL_ULONG_MAX|5.004000||p
++PERL_ULONG_MIN|5.004000||p
++PERL_UNUSED_ARG|5.009003||p
++PERL_UNUSED_CONTEXT|5.009004||p
++PERL_UNUSED_DECL|5.007002||p
++PERL_UNUSED_VAR|5.007002||p
++PERL_UQUAD_MAX|5.004000||p
++PERL_UQUAD_MIN|5.004000||p
++PERL_USE_GCC_BRACE_GROUPS|5.009004||p
++PERL_USHORT_MAX|5.004000||p
++PERL_USHORT_MIN|5.004000||p
++PERL_VERSION|5.006000||p
++PL_DBsignal|5.005000||p
++PL_DBsingle|||pn
++PL_DBsub|||pn
++PL_DBtrace|||pn
++PL_Sv|5.005000||p
++PL_bufend|5.019002||p
++PL_bufptr|5.019002||p
++PL_check||5.006000|
++PL_compiling|5.004050||p
++PL_comppad_name||5.017004|
++PL_comppad||5.008001|
++PL_copline|5.019002||p
++PL_curcop|5.004050||p
++PL_curpad||5.005000|
++PL_curstash|5.004050||p
++PL_debstash|5.004050||p
++PL_defgv|5.004050||p
++PL_diehook|5.004050||p
++PL_dirty|5.004050||p
++PL_dowarn|||pn
++PL_errgv|5.004050||p
++PL_error_count|5.019002||p
++PL_expect|5.019002||p
++PL_hexdigit|5.005000||p
++PL_hints|5.005000||p
++PL_in_my_stash|5.019002||p
++PL_in_my|5.019002||p
++PL_keyword_plugin||5.011002|
++PL_last_in_gv|||n
++PL_laststatval|5.005000||p
++PL_lex_state|5.019002||p
++PL_lex_stuff|5.019002||p
++PL_linestr|5.019002||p
++PL_modglobal||5.005000|n
++PL_na|5.004050||pn
++PL_no_modify|5.006000||p
++PL_ofsgv|||n
++PL_opfreehook||5.011000|n
++PL_parser|5.009005|5.009005|p
++PL_peepp||5.007003|n
++PL_perl_destruct_level|5.004050||p
++PL_perldb|5.004050||p
++PL_ppaddr|5.006000||p
++PL_rpeepp||5.013005|n
++PL_rsfp_filters|5.019002||p
++PL_rsfp|5.019002||p
++PL_rs|||n
++PL_signals|5.008001||p
++PL_stack_base|5.004050||p
++PL_stack_sp|5.004050||p
++PL_statcache|5.005000||p
++PL_stdingv|5.004050||p
++PL_sv_arenaroot|5.004050||p
++PL_sv_no|5.004050||pn
++PL_sv_undef|5.004050||pn
++PL_sv_yes|5.004050||pn
++PL_tainted|5.004050||p
++PL_tainting|5.004050||p
++PL_tokenbuf|5.019002||p
++POP_MULTICALL||5.019003|
++POPi|||n
++POPl|||n
++POPn|||n
++POPpbytex||5.007001|n
++POPpx||5.005030|n
++POPp|||n
++POPs|||n
++PTR2IV|5.006000||p
++PTR2NV|5.006000||p
++PTR2UV|5.006000||p
++PTR2nat|5.009003||p
++PTR2ul|5.007001||p
++PTRV|5.006000||p
++PUSHMARK|||
++PUSH_MULTICALL||5.019003|
++PUSHi|||
++PUSHmortal|5.009002||p
++PUSHn|||
++PUSHp|||
++PUSHs|||
++PUSHu|5.004000||p
++PUTBACK|||
++PadARRAY||5.019003|
++PadMAX||5.019003|
++PadlistARRAY||5.019003|
++PadlistMAX||5.019003|
++PadlistNAMESARRAY||5.019003|
++PadlistNAMESMAX||5.019003|
++PadlistNAMES||5.019003|
++PadlistREFCNT||5.017004|
++PadnameIsOUR|||
++PadnameIsSTATE|||
++PadnameLEN||5.019003|
++PadnameOURSTASH|||
++PadnameOUTER|||
++PadnamePV||5.019003|
++PadnameSV||5.019003|
++PadnameTYPE|||
++PadnameUTF8||5.019003|
++PadnamelistARRAY||5.019003|
++PadnamelistMAX||5.019003|
++PerlIO_clearerr||5.007003|
++PerlIO_close||5.007003|
++PerlIO_context_layers||5.009004|
++PerlIO_eof||5.007003|
++PerlIO_error||5.007003|
++PerlIO_fileno||5.007003|
++PerlIO_fill||5.007003|
++PerlIO_flush||5.007003|
++PerlIO_get_base||5.007003|
++PerlIO_get_bufsiz||5.007003|
++PerlIO_get_cnt||5.007003|
++PerlIO_get_ptr||5.007003|
++PerlIO_read||5.007003|
++PerlIO_seek||5.007003|
++PerlIO_set_cnt||5.007003|
++PerlIO_set_ptrcnt||5.007003|
++PerlIO_setlinebuf||5.007003|
++PerlIO_stderr||5.007003|
++PerlIO_stdin||5.007003|
++PerlIO_stdout||5.007003|
++PerlIO_tell||5.007003|
++PerlIO_unread||5.007003|
++PerlIO_write||5.007003|
++Perl_signbit||5.009005|n
++PoisonFree|5.009004||p
++PoisonNew|5.009004||p
++PoisonWith|5.009004||p
++Poison|5.008000||p
++READ_XDIGIT||5.017006|
++RETVAL|||n
++Renewc|||
++Renew|||
++SAVECLEARSV|||
++SAVECOMPPAD|||
++SAVEPADSV|||
++SAVETMPS|||
++SAVE_DEFSV|5.004050||p
++SPAGAIN|||
++SP|||
++START_EXTERN_C|5.005000||p
++START_MY_CXT|5.007003||p
++STMT_END|||p
++STMT_START|||p
++STR_WITH_LEN|5.009003||p
++ST|||
++SV_CONST_RETURN|5.009003||p
++SV_COW_DROP_PV|5.008001||p
++SV_COW_SHARED_HASH_KEYS|5.009005||p
++SV_GMAGIC|5.007002||p
++SV_HAS_TRAILING_NUL|5.009004||p
++SV_IMMEDIATE_UNREF|5.007001||p
++SV_MUTABLE_RETURN|5.009003||p
++SV_NOSTEAL|5.009002||p
++SV_SMAGIC|5.009003||p
++SV_UTF8_NO_ENCODING|5.008001||p
++SVfARG|5.009005||p
++SVf_UTF8|5.006000||p
++SVf|5.006000||p
++SVt_INVLIST||5.019002|
++SVt_IV|||
++SVt_NULL|||
++SVt_NV|||
++SVt_PVAV|||
++SVt_PVCV|||
++SVt_PVFM|||
++SVt_PVGV|||
++SVt_PVHV|||
++SVt_PVIO|||
++SVt_PVIV|||
++SVt_PVLV|||
++SVt_PVMG|||
++SVt_PVNV|||
++SVt_PV|||
++SVt_REGEXP||5.011000|
++Safefree|||
++Slab_Alloc|||
++Slab_Free|||
++Slab_to_ro|||
++Slab_to_rw|||
++StructCopy|||
++SvCUR_set|||
++SvCUR|||
++SvEND|||
++SvGAMAGIC||5.006001|
++SvGETMAGIC|5.004050||p
++SvGROW|||
++SvIOK_UV||5.006000|
++SvIOK_notUV||5.006000|
++SvIOK_off|||
++SvIOK_only_UV||5.006000|
++SvIOK_only|||
++SvIOK_on|||
++SvIOKp|||
++SvIOK|||
++SvIVX|||
++SvIV_nomg|5.009001||p
++SvIV_set|||
++SvIVx|||
++SvIV|||
++SvIsCOW_shared_hash||5.008003|
++SvIsCOW||5.008003|
++SvLEN_set|||
++SvLEN|||
++SvLOCK||5.007003|
++SvMAGIC_set|5.009003||p
++SvNIOK_off|||
++SvNIOKp|||
++SvNIOK|||
++SvNOK_off|||
++SvNOK_only|||
++SvNOK_on|||
++SvNOKp|||
++SvNOK|||
++SvNVX|||
++SvNV_nomg||5.013002|
++SvNV_set|||
++SvNVx|||
++SvNV|||
++SvOK|||
++SvOOK_offset||5.011000|
++SvOOK|||
++SvPOK_off|||
++SvPOK_only_UTF8||5.006000|
++SvPOK_only|||
++SvPOK_on|||
++SvPOKp|||
++SvPOK|||
++SvPVX_const|5.009003||p
++SvPVX_mutable|5.009003||p
++SvPVX|||
++SvPV_const|5.009003||p
++SvPV_flags_const_nolen|5.009003||p
++SvPV_flags_const|5.009003||p
++SvPV_flags_mutable|5.009003||p
++SvPV_flags|5.007002||p
++SvPV_force_flags_mutable|5.009003||p
++SvPV_force_flags_nolen|5.009003||p
++SvPV_force_flags|5.007002||p
++SvPV_force_mutable|5.009003||p
++SvPV_force_nolen|5.009003||p
++SvPV_force_nomg_nolen|5.009003||p
++SvPV_force_nomg|5.007002||p
++SvPV_force|||p
++SvPV_mutable|5.009003||p
++SvPV_nolen_const|5.009003||p
++SvPV_nolen|5.006000||p
++SvPV_nomg_const_nolen|5.009003||p
++SvPV_nomg_const|5.009003||p
++SvPV_nomg_nolen|5.013007||p
++SvPV_nomg|5.007002||p
++SvPV_renew|5.009003||p
++SvPV_set|||
++SvPVbyte_force||5.009002|
++SvPVbyte_nolen||5.006000|
++SvPVbytex_force||5.006000|
++SvPVbytex||5.006000|
++SvPVbyte|5.006000||p
++SvPVutf8_force||5.006000|
++SvPVutf8_nolen||5.006000|
++SvPVutf8x_force||5.006000|
++SvPVutf8x||5.006000|
++SvPVutf8||5.006000|
++SvPVx|||
++SvPV|||
++SvREFCNT_dec_NN||5.017007|
++SvREFCNT_dec|||
++SvREFCNT_inc_NN|5.009004||p
++SvREFCNT_inc_simple_NN|5.009004||p
++SvREFCNT_inc_simple_void_NN|5.009004||p
++SvREFCNT_inc_simple_void|5.009004||p
++SvREFCNT_inc_simple|5.009004||p
++SvREFCNT_inc_void_NN|5.009004||p
++SvREFCNT_inc_void|5.009004||p
++SvREFCNT_inc|||p
++SvREFCNT|||
++SvROK_off|||
++SvROK_on|||
++SvROK|||
++SvRV_set|5.009003||p
++SvRV|||
++SvRXOK||5.009005|
++SvRX||5.009005|
++SvSETMAGIC|||
++SvSHARED_HASH|5.009003||p
++SvSHARE||5.007003|
++SvSTASH_set|5.009003||p
++SvSTASH|||
++SvSetMagicSV_nosteal||5.004000|
++SvSetMagicSV||5.004000|
++SvSetSV_nosteal||5.004000|
++SvSetSV|||
++SvTAINTED_off||5.004000|
++SvTAINTED_on||5.004000|
++SvTAINTED||5.004000|
++SvTAINT|||
++SvTHINKFIRST|||
++SvTRUE_nomg||5.013006|
++SvTRUE|||
++SvTYPE|||
++SvUNLOCK||5.007003|
++SvUOK|5.007001|5.006000|p
++SvUPGRADE|||
++SvUTF8_off||5.006000|
++SvUTF8_on||5.006000|
++SvUTF8||5.006000|
++SvUVXx|5.004000||p
++SvUVX|5.004000||p
++SvUV_nomg|5.009001||p
++SvUV_set|5.009003||p
++SvUVx|5.004000||p
++SvUV|5.004000||p
++SvVOK||5.008001|
++SvVSTRING_mg|5.009004||p
++THIS|||n
++UNDERBAR|5.009002||p
++UTF8_MAXBYTES|5.009002||p
++UVSIZE|5.006000||p
++UVTYPE|5.006000||p
++UVXf|5.007001||p
++UVof|5.006000||p
++UVuf|5.006000||p
++UVxf|5.006000||p
++WARN_ALL|5.006000||p
++WARN_AMBIGUOUS|5.006000||p
++WARN_ASSERTIONS|5.019002||p
++WARN_BAREWORD|5.006000||p
++WARN_CLOSED|5.006000||p
++WARN_CLOSURE|5.006000||p
++WARN_DEBUGGING|5.006000||p
++WARN_DEPRECATED|5.006000||p
++WARN_DIGIT|5.006000||p
++WARN_EXEC|5.006000||p
++WARN_EXITING|5.006000||p
++WARN_GLOB|5.006000||p
++WARN_INPLACE|5.006000||p
++WARN_INTERNAL|5.006000||p
++WARN_IO|5.006000||p
++WARN_LAYER|5.008000||p
++WARN_MALLOC|5.006000||p
++WARN_MISC|5.006000||p
++WARN_NEWLINE|5.006000||p
++WARN_NUMERIC|5.006000||p
++WARN_ONCE|5.006000||p
++WARN_OVERFLOW|5.006000||p
++WARN_PACK|5.006000||p
++WARN_PARENTHESIS|5.006000||p
++WARN_PIPE|5.006000||p
++WARN_PORTABLE|5.006000||p
++WARN_PRECEDENCE|5.006000||p
++WARN_PRINTF|5.006000||p
++WARN_PROTOTYPE|5.006000||p
++WARN_QW|5.006000||p
++WARN_RECURSION|5.006000||p
++WARN_REDEFINE|5.006000||p
++WARN_REGEXP|5.006000||p
++WARN_RESERVED|5.006000||p
++WARN_SEMICOLON|5.006000||p
++WARN_SEVERE|5.006000||p
++WARN_SIGNAL|5.006000||p
++WARN_SUBSTR|5.006000||p
++WARN_SYNTAX|5.006000||p
++WARN_TAINT|5.006000||p
++WARN_THREADS|5.008000||p
++WARN_UNINITIALIZED|5.006000||p
++WARN_UNOPENED|5.006000||p
++WARN_UNPACK|5.006000||p
++WARN_UNTIE|5.006000||p
++WARN_UTF8|5.006000||p
++WARN_VOID|5.006000||p
++WIDEST_UTYPE|5.015004||p
++XCPT_CATCH|5.009002||p
++XCPT_RETHROW|5.009002|5.007001|p
++XCPT_TRY_END|5.009002|5.004000|p
++XCPT_TRY_START|5.009002|5.004000|p
++XPUSHi|||
++XPUSHmortal|5.009002||p
++XPUSHn|||
++XPUSHp|||
++XPUSHs|||
++XPUSHu|5.004000||p
++XSPROTO|5.010000||p
++XSRETURN_EMPTY|||
++XSRETURN_IV|||
++XSRETURN_NO|||
++XSRETURN_NV|||
++XSRETURN_PV|||
++XSRETURN_UNDEF|||
++XSRETURN_UV|5.008001||p
++XSRETURN_YES|||
++XSRETURN|||p
++XST_mIV|||
++XST_mNO|||
++XST_mNV|||
++XST_mPV|||
++XST_mUNDEF|||
++XST_mUV|5.008001||p
++XST_mYES|||
++XS_APIVERSION_BOOTCHECK||5.013004|
++XS_EXTERNAL||5.019003|
++XS_INTERNAL||5.019003|
++XS_VERSION_BOOTCHECK|||
++XS_VERSION|||
++XSprePUSH|5.006000||p
++XS|||
++XopDISABLE||5.019003|
++XopENABLE||5.019003|
++XopENTRY_set||5.019003|
++XopENTRY||5.019003|
++XopFLAGS||5.013007|
++ZeroD|5.009002||p
++Zero|||
++_aMY_CXT|5.007003||p
++_add_range_to_invlist|||
++_append_range_to_invlist|||
++_core_swash_init|||
++_get_swash_invlist|||
++_invlist_array_init|||
++_invlist_contains_cp|||
++_invlist_contents|||
++_invlist_dump|||
++_invlist_intersection_maybe_complement_2nd|||
++_invlist_intersection|||
++_invlist_invert_prop|||
++_invlist_invert|||
++_invlist_len|||
++_invlist_populate_swatch|||
++_invlist_search|||
++_invlist_subtract|||
++_invlist_union_maybe_complement_2nd|||
++_invlist_union|||
++_is_uni_FOO||5.017008|
++_is_uni_perl_idcont||5.017008|
++_is_uni_perl_idstart||5.017007|
++_is_utf8_FOO||5.017008|
++_is_utf8_mark||5.017008|
++_is_utf8_perl_idcont||5.017008|
++_is_utf8_perl_idstart||5.017007|
++_new_invlist_C_array|||
++_new_invlist|||
++_pMY_CXT|5.007003||p
++_swash_inversion_hash|||
++_swash_to_invlist|||
++_to_fold_latin1|||
++_to_uni_fold_flags||5.013011|
++_to_upper_title_latin1|||
++_to_utf8_fold_flags||5.015006|
++_to_utf8_lower_flags||5.015006|
++_to_utf8_title_flags||5.015006|
++_to_utf8_upper_flags||5.015006|
++aMY_CXT_|5.007003||p
++aMY_CXT|5.007003||p
++aTHXR_|5.019002||p
++aTHXR|5.019002||p
++aTHX_|5.006000||p
++aTHX|5.006000||p
++aassign_common_vars|||
++add_cp_to_invlist|||
++add_data|||n
++add_utf16_textfilter|||
++addmad|||
++adjust_size_and_find_bucket|||n
++adjust_stack_on_leave|||
++alloc_maybe_populate_EXACT|||
++alloccopstash|||
++allocmy|||
++amagic_call|||
++amagic_cmp_locale|||
++amagic_cmp|||
++amagic_deref_call||5.013007|
++amagic_i_ncmp|||
++amagic_is_enabled|||
++amagic_ncmp|||
++anonymise_cv_maybe|||
++any_dup|||
++ao|||
++append_madprops|||
++apply_attrs_my|||
++apply_attrs_string||5.006001|
++apply_attrs|||
++apply|||
++assert_uft8_cache_coherent|||
++atfork_lock||5.007003|n
++atfork_unlock||5.007003|n
++av_arylen_p||5.009003|
++av_clear|||
++av_create_and_push||5.009005|
++av_create_and_unshift_one||5.009005|
++av_delete||5.006000|
++av_exists||5.006000|
++av_extend_guts|||
++av_extend|||
++av_fetch|||
++av_fill|||
++av_iter_p||5.011000|
++av_len|||
++av_make|||
++av_pop|||
++av_push|||
++av_reify|||
++av_shift|||
++av_store|||
++av_tindex||5.017009|
++av_top_index||5.017009|
++av_undef|||
++av_unshift|||
++ax|||n
++bad_type_gv|||
++bad_type_pv|||
++bind_match|||
++block_end|||
++block_gimme||5.004000|
++block_start|||
++blockhook_register||5.013003|
++boolSV|5.004000||p
++boot_core_PerlIO|||
++boot_core_UNIVERSAL|||
++boot_core_mro|||
++bytes_cmp_utf8||5.013007|
++bytes_from_utf8||5.007001|
++bytes_to_uni|||n
++bytes_to_utf8||5.006001|
++call_argv|5.006000||p
++call_atexit||5.006000|
++call_list||5.004000|
++call_method|5.006000||p
++call_pv|5.006000||p
++call_sv|5.006000||p
++caller_cx||5.013005|
++calloc||5.007002|n
++cando|||
++cast_i32||5.006000|
++cast_iv||5.006000|
++cast_ulong||5.006000|
++cast_uv||5.006000|
++check_locale_boundary_crossing|||
++check_type_and_open|||
++check_uni|||
++check_utf8_print|||
++checkcomma|||
++ckWARN|5.006000||p
++ck_entersub_args_core|||
++ck_entersub_args_list||5.013006|
++ck_entersub_args_proto_or_list||5.013006|
++ck_entersub_args_proto||5.013006|
++ck_warner_d||5.011001|v
++ck_warner||5.011001|v
++ckwarn_common|||
++ckwarn_d||5.009003|
++ckwarn||5.009003|
++cl_and|||n
++cl_anything|||n
++cl_init|||n
++cl_is_anything|||n
++cl_or|||n
++clear_placeholders|||
++clone_params_del|||n
++clone_params_new|||n
++closest_cop|||
++compute_EXACTish|||
++convert|||
++cop_fetch_label||5.015001|
++cop_free|||
++cop_hints_2hv||5.013007|
++cop_hints_fetch_pvn||5.013007|
++cop_hints_fetch_pvs||5.013007|
++cop_hints_fetch_pv||5.013007|
++cop_hints_fetch_sv||5.013007|
++cop_store_label||5.015001|
++cophh_2hv||5.013007|
++cophh_copy||5.013007|
++cophh_delete_pvn||5.013007|
++cophh_delete_pvs||5.013007|
++cophh_delete_pv||5.013007|
++cophh_delete_sv||5.013007|
++cophh_fetch_pvn||5.013007|
++cophh_fetch_pvs||5.013007|
++cophh_fetch_pv||5.013007|
++cophh_fetch_sv||5.013007|
++cophh_free||5.013007|
++cophh_new_empty||5.019003|
++cophh_store_pvn||5.013007|
++cophh_store_pvs||5.013007|
++cophh_store_pv||5.013007|
++cophh_store_sv||5.013007|
++core_prototype|||
++core_regclass_swash|||
++coresub_op|||
++could_it_be_a_POSIX_class|||
++cr_textfilter|||
++create_eval_scope|||
++croak_memory_wrap||5.019003|n
++croak_no_mem|||n
++croak_no_modify||5.013003|n
++croak_nocontext|||vn
++croak_popstack|||n
++croak_sv||5.013001|
++croak_xs_usage||5.010001|n
++croak|||v
++csighandler||5.009003|n
++curmad|||
++current_re_engine|||
++curse|||
++custom_op_desc||5.007003|
++custom_op_name||5.007003|
++custom_op_register||5.013007|
++custom_op_xop||5.013007|
++cv_ckproto_len_flags|||
++cv_clone_into|||
++cv_clone|||
++cv_const_sv_or_av|||
++cv_const_sv||5.004000|
++cv_dump|||
++cv_forget_slab|||
++cv_get_call_checker||5.013006|
++cv_set_call_checker||5.013006|
++cv_undef|||
++cvgv_set|||
++cvstash_set|||
++cx_dump||5.005000|
++cx_dup|||
++cxinc|||
++dAXMARK|5.009003||p
++dAX|5.007002||p
++dITEMS|5.007002||p
++dMARK|||
++dMULTICALL||5.009003|
++dMY_CXT_SV|5.007003||p
++dMY_CXT|5.007003||p
++dNOOP|5.006000||p
++dORIGMARK|||
++dSP|||
++dTHR|5.004050||p
++dTHXR|5.019002||p
++dTHXa|5.006000||p
++dTHXoa|5.006000||p
++dTHX|5.006000||p
++dUNDERBAR|5.009002||p
++dVAR|5.009003||p
++dXCPT|5.009002||p
++dXSARGS|||
++dXSI32|||
++dXSTARG|5.006000||p
++deb_curcv|||
++deb_nocontext|||vn
++deb_stack_all|||
++deb_stack_n|||
++debop||5.005000|
++debprofdump||5.005000|
++debprof|||
++debstackptrs||5.007003|
++debstack||5.007003|
++debug_start_match|||
++deb||5.007003|v
++defelem_target|||
++del_sv|||
++delete_eval_scope|||
++delimcpy||5.004000|n
++deprecate_commaless_var_list|||
++despatch_signals||5.007001|
++destroy_matcher|||
++die_nocontext|||vn
++die_sv||5.013001|
++die_unwind|||
++die|||v
++dirp_dup|||
++div128|||
++djSP|||
++do_aexec5|||
++do_aexec|||
++do_aspawn|||
++do_binmode||5.004050|
++do_chomp|||
++do_close|||
++do_delete_local|||
++do_dump_pad|||
++do_eof|||
++do_exec3|||
++do_execfree|||
++do_exec|||
++do_gv_dump||5.006000|
++do_gvgv_dump||5.006000|
++do_hv_dump||5.006000|
++do_ipcctl|||
++do_ipcget|||
++do_join|||
++do_magic_dump||5.006000|
++do_msgrcv|||
++do_msgsnd|||
++do_ncmp|||
++do_oddball|||
++do_op_dump||5.006000|
++do_op_xmldump|||
++do_open9||5.006000|
++do_openn||5.007001|
++do_open||5.004000|
++do_pmop_dump||5.006000|
++do_pmop_xmldump|||
++do_print|||
++do_readline|||
++do_seek|||
++do_semop|||
++do_shmio|||
++do_smartmatch|||
++do_spawn_nowait|||
++do_spawn|||
++do_sprintf|||
++do_sv_dump||5.006000|
++do_sysseek|||
++do_tell|||
++do_trans_complex_utf8|||
++do_trans_complex|||
++do_trans_count_utf8|||
++do_trans_count|||
++do_trans_simple_utf8|||
++do_trans_simple|||
++do_trans|||
++do_vecget|||
++do_vecset|||
++do_vop|||
++docatch|||
++doeval|||
++dofile|||
++dofindlabel|||
++doform|||
++doing_taint||5.008001|n
++dooneliner|||
++doopen_pm|||
++doparseform|||
++dopoptoeval|||
++dopoptogiven|||
++dopoptolabel|||
++dopoptoloop|||
++dopoptosub_at|||
++dopoptowhen|||
++doref||5.009003|
++dounwind|||
++dowantarray|||
++dump_all_perl|||
++dump_all||5.006000|
++dump_eval||5.006000|
++dump_exec_pos|||
++dump_fds|||
++dump_form||5.006000|
++dump_indent||5.006000|v
++dump_mstats|||
++dump_packsubs_perl|||
++dump_packsubs||5.006000|
++dump_sub_perl|||
++dump_sub||5.006000|
++dump_sv_child|||
++dump_trie_interim_list|||
++dump_trie_interim_table|||
++dump_trie|||
++dump_vindent||5.006000|
++dumpuntil|||
++dup_attrlist|||
++emulate_cop_io|||
++eval_pv|5.006000||p
++eval_sv|5.006000||p
++exec_failed|||
++expect_number|||
++fbm_compile||5.005000|
++fbm_instr||5.005000|
++feature_is_enabled|||
++filter_add|||
++filter_del|||
++filter_gets|||
++filter_read|||
++finalize_optree|||
++finalize_op|||
++find_and_forget_pmops|||
++find_array_subscript|||
++find_beginning|||
++find_byclass|||
++find_hash_subscript|||
++find_in_my_stash|||
++find_lexical_cv|||
++find_runcv_where|||
++find_runcv||5.008001|
++find_rundefsv2|||
++find_rundefsvoffset||5.009002|
++find_rundefsv||5.013002|
++find_script|||
++find_uninit_var|||
++first_symbol|||n
++foldEQ_latin1||5.013008|n
++foldEQ_locale||5.013002|n
++foldEQ_utf8_flags||5.013010|
++foldEQ_utf8||5.013002|
++foldEQ||5.013002|n
++fold_constants|||
++forbid_setid|||
++force_ident_maybe_lex|||
++force_ident|||
++force_list|||
++force_next|||
++force_strict_version|||
++force_version|||
++force_word|||
++forget_pmop|||
++form_nocontext|||vn
++form_short_octal_warning|||
++form||5.004000|v
++fp_dup|||
++fprintf_nocontext|||vn
++free_global_struct|||
++free_tied_hv_pool|||
++free_tmps|||
++gen_constant_list|||
++get_and_check_backslash_N_name|||
++get_aux_mg|||
++get_av|5.006000||p
++get_context||5.006000|n
++get_cvn_flags|5.009005||p
++get_cvs|5.011000||p
++get_cv|5.006000||p
++get_db_sub|||
++get_debug_opts|||
++get_hash_seed|||
++get_hv|5.006000||p
++get_invlist_iter_addr|||
++get_invlist_offset_addr|||
++get_invlist_previous_index_addr|||
++get_mstats|||
++get_no_modify|||
++get_num|||
++get_op_descs||5.005000|
++get_op_names||5.005000|
++get_opargs|||
++get_ppaddr||5.006000|
++get_re_arg|||
++get_sv|5.006000||p
++get_vtbl||5.005030|
++getcwd_sv||5.007002|
++getenv_len|||
++glob_2number|||
++glob_assign_glob|||
++glob_assign_ref|||
++gp_dup|||
++gp_free|||
++gp_ref|||
++grok_bin|5.007003||p
++grok_bslash_N|||
++grok_bslash_c|||
++grok_bslash_o|||
++grok_bslash_x|||
++grok_hex|5.007003||p
++grok_number|5.007002||p
++grok_numeric_radix|5.007002||p
++grok_oct|5.007003||p
++group_end|||
++gv_AVadd|||
++gv_HVadd|||
++gv_IOadd|||
++gv_SVadd|||
++gv_add_by_type||5.011000|
++gv_autoload4||5.004000|
++gv_autoload_pvn||5.015004|
++gv_autoload_pv||5.015004|
++gv_autoload_sv||5.015004|
++gv_check|||
++gv_const_sv||5.009003|
++gv_dump||5.006000|
++gv_efullname3||5.004000|
++gv_efullname4||5.006001|
++gv_efullname|||
++gv_ename|||
++gv_fetchfile_flags||5.009005|
++gv_fetchfile|||
++gv_fetchmeth_autoload||5.007003|
++gv_fetchmeth_pv_autoload||5.015004|
++gv_fetchmeth_pvn_autoload||5.015004|
++gv_fetchmeth_pvn||5.015004|
++gv_fetchmeth_pv||5.015004|
++gv_fetchmeth_sv_autoload||5.015004|
++gv_fetchmeth_sv||5.015004|
++gv_fetchmethod_autoload||5.004000|
++gv_fetchmethod_pv_flags||5.015004|
++gv_fetchmethod_pvn_flags||5.015004|
++gv_fetchmethod_sv_flags||5.015004|
++gv_fetchmethod|||
++gv_fetchmeth|||
++gv_fetchpvn_flags|5.009002||p
++gv_fetchpvs|5.009004||p
++gv_fetchpv|||
++gv_fetchsv|5.009002||p
++gv_fullname3||5.004000|
++gv_fullname4||5.006001|
++gv_fullname|||
++gv_handler||5.007001|
++gv_init_pvn||5.015004|
++gv_init_pv||5.015004|
++gv_init_svtype|||
++gv_init_sv||5.015004|
++gv_init|||
++gv_magicalize_isa|||
++gv_name_set||5.009004|
++gv_stashpvn|5.004000||p
++gv_stashpvs|5.009003||p
++gv_stashpv|||
++gv_stashsv|||
++gv_try_downgrade|||
++handle_regex_sets|||
++he_dup|||
++hek_dup|||
++hfree_next_entry|||
++hfreeentries|||
++hsplit|||
++hv_assert|||
++hv_auxinit|||
++hv_backreferences_p|||
++hv_clear_placeholders||5.009001|
++hv_clear|||
++hv_common_key_len||5.010000|
++hv_common||5.010000|
++hv_copy_hints_hv||5.009004|
++hv_delayfree_ent||5.004000|
++hv_delete_common|||
++hv_delete_ent||5.004000|
++hv_delete|||
++hv_eiter_p||5.009003|
++hv_eiter_set||5.009003|
++hv_ename_add|||
++hv_ename_delete|||
++hv_exists_ent||5.004000|
++hv_exists|||
++hv_fetch_ent||5.004000|
++hv_fetchs|5.009003||p
++hv_fetch|||
++hv_fill||5.013002|
++hv_free_ent_ret|||
++hv_free_ent||5.004000|
++hv_iterinit|||
++hv_iterkeysv||5.004000|
++hv_iterkey|||
++hv_iternext_flags||5.008000|
++hv_iternextsv|||
++hv_iternext|||
++hv_iterval|||
++hv_kill_backrefs|||
++hv_ksplit||5.004000|
++hv_magic_check|||n
++hv_magic|||
++hv_name_set||5.009003|
++hv_notallowed|||
++hv_placeholders_get||5.009003|
++hv_placeholders_p|||
++hv_placeholders_set||5.009003|
++hv_rand_set||5.017011|
++hv_riter_p||5.009003|
++hv_riter_set||5.009003|
++hv_scalar||5.009001|
++hv_store_ent||5.004000|
++hv_store_flags||5.008000|
++hv_stores|5.009004||p
++hv_store|||
++hv_undef_flags|||
++hv_undef|||
++ibcmp_locale||5.004000|
++ibcmp_utf8||5.007003|
++ibcmp|||
++incline|||
++incpush_if_exists|||
++incpush_use_sep|||
++incpush|||
++ingroup|||
++init_argv_symbols|||
++init_constants|||
++init_dbargs|||
++init_debugger|||
++init_global_struct|||
++init_i18nl10n||5.006000|
++init_i18nl14n||5.006000|
++init_ids|||
++init_interp|||
++init_main_stash|||
++init_perllib|||
++init_postdump_symbols|||
++init_predump_symbols|||
++init_stacks||5.005000|
++init_tm||5.007002|
++inplace_aassign|||
++instr|||n
++intro_my|||
++intuit_method|||
++intuit_more|||
++invert|||
++invlist_array|||
++invlist_clone|||
++invlist_extend|||
++invlist_highest|||
++invlist_is_iterating|||
++invlist_iterfinish|||
++invlist_iterinit|||
++invlist_iternext|||
++invlist_max|||
++invlist_previous_index|||
++invlist_set_len|||
++invlist_set_previous_index|||
++invlist_trim|||
++invoke_exception_hook|||
++io_close|||
++isALNUMC|5.006000||p
++isALNUM_lazy|||
++isALPHANUMERIC||5.017008|
++isALPHA|||
++isASCII|5.006000|5.006000|p
++isBLANK|5.006001||p
++isCNTRL|5.006000|5.006000|p
++isDIGIT|||
++isFOO_lc|||
++isFOO_utf8_lc|||
++isGRAPH|5.006000||p
++isGV_with_GP|5.009004||p
++isIDCONT||5.017008|
++isIDFIRST_lazy|||
++isIDFIRST|||
++isLOWER|||
++isOCTAL||5.013005|
++isPRINT|5.004000||p
++isPSXSPC|5.006001||p
++isPUNCT|5.006000||p
++isSPACE|||
++isUPPER|||
++isWORDCHAR||5.013006|
++isXDIGIT|5.006000||p
++is_an_int|||
++is_ascii_string||5.011000|n
++is_cur_LC_category_utf8|||
++is_handle_constructor|||n
++is_list_assignment|||
++is_lvalue_sub||5.007001|
++is_uni_alnum_lc||5.006000|
++is_uni_alnumc_lc||5.017007|
++is_uni_alnumc||5.017007|
++is_uni_alnum||5.006000|
++is_uni_alpha_lc||5.006000|
++is_uni_alpha||5.006000|
++is_uni_ascii_lc||5.006000|
++is_uni_ascii||5.006000|
++is_uni_blank_lc||5.017002|
++is_uni_blank||5.017002|
++is_uni_cntrl_lc||5.006000|
++is_uni_cntrl||5.006000|
++is_uni_digit_lc||5.006000|
++is_uni_digit||5.006000|
++is_uni_graph_lc||5.006000|
++is_uni_graph||5.006000|
++is_uni_idfirst_lc||5.006000|
++is_uni_idfirst||5.006000|
++is_uni_lower_lc||5.006000|
++is_uni_lower||5.006000|
++is_uni_print_lc||5.006000|
++is_uni_print||5.006000|
++is_uni_punct_lc||5.006000|
++is_uni_punct||5.006000|
++is_uni_space_lc||5.006000|
++is_uni_space||5.006000|
++is_uni_upper_lc||5.006000|
++is_uni_upper||5.006000|
++is_uni_xdigit_lc||5.006000|
++is_uni_xdigit||5.006000|
++is_utf8_alnumc||5.017007|
++is_utf8_alnum||5.006000|
++is_utf8_alpha||5.006000|
++is_utf8_ascii||5.006000|
++is_utf8_blank||5.017002|
++is_utf8_char_buf||5.015008|n
++is_utf8_char_slow|||n
++is_utf8_char||5.006000|n
++is_utf8_cntrl||5.006000|
++is_utf8_common|||
++is_utf8_digit||5.006000|
++is_utf8_graph||5.006000|
++is_utf8_idcont||5.008000|
++is_utf8_idfirst||5.006000|
++is_utf8_lower||5.006000|
++is_utf8_mark||5.006000|
++is_utf8_perl_space||5.011001|
++is_utf8_perl_word||5.011001|
++is_utf8_posix_digit||5.011001|
++is_utf8_print||5.006000|
++is_utf8_punct||5.006000|
++is_utf8_space||5.006000|
++is_utf8_string_loclen||5.009003|n
++is_utf8_string_loc||5.008001|n
++is_utf8_string||5.006001|n
++is_utf8_upper||5.006000|
++is_utf8_xdigit||5.006000|
++is_utf8_xidcont||5.013010|
++is_utf8_xidfirst||5.013010|
++isa_lookup|||
++items|||n
++ix|||n
++jmaybe|||
++join_exact|||
++keyword_plugin_standard|||
++keyword|||
++leave_scope|||
++lex_bufutf8||5.011002|
++lex_discard_to||5.011002|
++lex_grow_linestr||5.011002|
++lex_next_chunk||5.011002|
++lex_peek_unichar||5.011002|
++lex_read_space||5.011002|
++lex_read_to||5.011002|
++lex_read_unichar||5.011002|
++lex_start||5.009005|
++lex_stuff_pvn||5.011002|
++lex_stuff_pvs||5.013005|
++lex_stuff_pv||5.013006|
++lex_stuff_sv||5.011002|
++lex_unstuff||5.011002|
++listkids|||
++list|||
++load_module_nocontext|||vn
++load_module|5.006000||pv
++localize|||
++looks_like_bool|||
++looks_like_number|||
++lop|||
++mPUSHi|5.009002||p
++mPUSHn|5.009002||p
++mPUSHp|5.009002||p
++mPUSHs|5.010001||p
++mPUSHu|5.009002||p
++mXPUSHi|5.009002||p
++mXPUSHn|5.009002||p
++mXPUSHp|5.009002||p
++mXPUSHs|5.010001||p
++mXPUSHu|5.009002||p
++mad_free|||
++madlex|||
++madparse|||
++magic_clear_all_env|||
++magic_cleararylen_p|||
++magic_clearenv|||
++magic_clearhints|||
++magic_clearhint|||
++magic_clearisa|||
++magic_clearpack|||
++magic_clearsig|||
++magic_copycallchecker|||
++magic_dump||5.006000|
++magic_existspack|||
++magic_freearylen_p|||
++magic_freeovrld|||
++magic_getarylen|||
++magic_getdefelem|||
++magic_getnkeys|||
++magic_getpack|||
++magic_getpos|||
++magic_getsig|||
++magic_getsubstr|||
++magic_gettaint|||
++magic_getuvar|||
++magic_getvec|||
++magic_get|||
++magic_killbackrefs|||
++magic_methcall1|||
++magic_methcall|||v
++magic_methpack|||
++magic_nextpack|||
++magic_regdata_cnt|||
++magic_regdatum_get|||
++magic_regdatum_set|||
++magic_scalarpack|||
++magic_set_all_env|||
++magic_setarylen|||
++magic_setcollxfrm|||
++magic_setdbline|||
++magic_setdefelem|||
++magic_setenv|||
++magic_sethint|||
++magic_setisa|||
++magic_setmglob|||
++magic_setnkeys|||
++magic_setpack|||
++magic_setpos|||
++magic_setregexp|||
++magic_setsig|||
++magic_setsubstr|||
++magic_settaint|||
++magic_setutf8|||
++magic_setuvar|||
++magic_setvec|||
++magic_set|||
++magic_sizepack|||
++magic_wipepack|||
++make_matcher|||
++make_trie_failtable|||
++make_trie|||
++malloc_good_size|||n
++malloced_size|||n
++malloc||5.007002|n
++markstack_grow|||
++matcher_matches_sv|||
++mayberelocate|||
++measure_struct|||
++memEQs|5.009005||p
++memEQ|5.004000||p
++memNEs|5.009005||p
++memNE|5.004000||p
++mem_collxfrm|||
++mem_log_common|||n
++mess_alloc|||
++mess_nocontext|||vn
++mess_sv||5.013001|
++mess||5.006000|v
++method_common|||
++mfree||5.007002|n
++mg_clear|||
++mg_copy|||
++mg_dup|||
++mg_find_mglob|||
++mg_findext||5.013008|
++mg_find|||
++mg_free_type||5.013006|
++mg_free|||
++mg_get|||
++mg_length||5.005000|
++mg_localize|||
++mg_magical|||
++mg_set|||
++mg_size||5.005000|
++mini_mktime||5.007002|
++minus_v|||
++missingterm|||
++mode_from_discipline|||
++modkids|||
++more_bodies|||
++more_sv|||
++moreswitches|||
++mro_clean_isarev|||
++mro_gather_and_rename|||
++mro_get_from_name||5.010001|
++mro_get_linear_isa_dfs|||
++mro_get_linear_isa||5.009005|
++mro_get_private_data||5.010001|
++mro_isa_changed_in|||
++mro_meta_dup|||
++mro_meta_init|||
++mro_method_changed_in||5.009005|
++mro_package_moved|||
++mro_register||5.010001|
++mro_set_mro||5.010001|
++mro_set_private_data||5.010001|
++mul128|||
++mulexp10|||n
++my_atof2||5.007002|
++my_atof||5.006000|
++my_attrs|||
++my_bcopy|||n
++my_bzero|||n
++my_chsize|||
++my_clearenv|||
++my_cxt_index|||
++my_cxt_init|||
++my_dirfd||5.009005|
++my_exit_jump|||
++my_exit|||
++my_failure_exit||5.004000|
++my_fflush_all||5.006000|
++my_fork||5.007003|n
++my_kid|||
++my_lstat_flags|||
++my_lstat||5.019003|
++my_memcmp|||n
++my_memset||5.004000|n
++my_pclose||5.004000|
++my_popen_list||5.007001|
++my_popen||5.004000|
++my_setenv|||
++my_snprintf|5.009004||pvn
++my_socketpair||5.007003|n
++my_sprintf|5.009003||pvn
++my_stat_flags|||
++my_stat||5.019003|
++my_strftime||5.007002|
++my_strlcat|5.009004||pn
++my_strlcpy|5.009004||pn
++my_unexec|||
++my_vsnprintf||5.009004|n
++need_utf8|||n
++newANONATTRSUB||5.006000|
++newANONHASH|||
++newANONLIST|||
++newANONSUB|||
++newASSIGNOP|||
++newATTRSUB_flags|||
++newATTRSUB||5.006000|
++newAVREF|||
++newAV|||
++newBINOP|||
++newCONDOP|||
++newCONSTSUB_flags||5.015006|
++newCONSTSUB|5.004050||p
++newCVREF|||
++newDEFSVOP|||
++newFORM|||
++newFOROP||5.013007|
++newGIVENOP||5.009003|
++newGIVWHENOP|||
++newGP|||
++newGVOP|||
++newGVREF|||
++newGVgen_flags||5.015004|
++newGVgen|||
++newHVREF|||
++newHVhv||5.005000|
++newHV|||
++newIO|||
++newLISTOP|||
++newLOGOP|||
++newLOOPEX|||
++newLOOPOP|||
++newMADPROP|||
++newMADsv|||
++newMYSUB||5.017004|
++newNULLLIST|||
++newOP|||
++newPADOP|||
++newPMOP|||
++newPROG|||
++newPVOP|||
++newRANGE|||
++newRV_inc|5.004000||p
++newRV_noinc|5.004000||p
++newRV|||
++newSLICEOP|||
++newSTATEOP|||
++newSTUB|||
++newSUB|||
++newSVOP|||
++newSVREF|||
++newSV_type|5.009005||p
++newSVhek||5.009003|
++newSViv|||
++newSVnv|||
++newSVpadname||5.017004|
++newSVpv_share||5.013006|
++newSVpvf_nocontext|||vn
++newSVpvf||5.004000|v
++newSVpvn_flags|5.010001||p
++newSVpvn_share|5.007001||p
++newSVpvn_utf8|5.010001||p
++newSVpvn|5.004050||p
++newSVpvs_flags|5.010001||p
++newSVpvs_share|5.009003||p
++newSVpvs|5.009003||p
++newSVpv|||
++newSVrv|||
++newSVsv|||
++newSVuv|5.006000||p
++newSV|||
++newTOKEN|||
++newUNOP|||
++newWHENOP||5.009003|
++newWHILEOP||5.013007|
++newXS_flags||5.009004|
++newXS_len_flags|||
++newXSproto||5.006000|
++newXS||5.006000|
++new_collate||5.006000|
++new_constant|||
++new_ctype||5.006000|
++new_he|||
++new_logop|||
++new_numeric||5.006000|
++new_stackinfo||5.005000|
++new_version||5.009000|
++new_warnings_bitfield|||
++next_symbol|||
++nextargv|||
++nextchar|||
++ninstr|||n
++no_bareword_allowed|||
++no_fh_allowed|||
++no_op|||
++not_a_number|||
++not_incrementable|||
++nothreadhook||5.008000|
++nuke_stacks|||
++num_overflow|||n
++oopsAV|||
++oopsHV|||
++op_append_elem||5.013006|
++op_append_list||5.013006|
++op_clear|||
++op_const_sv|||
++op_contextualize||5.013006|
++op_dump||5.006000|
++op_free|||
++op_getmad_weak|||
++op_getmad|||
++op_integerize|||
++op_linklist||5.013006|
++op_lvalue_flags|||
++op_lvalue||5.013007|
++op_null||5.007002|
++op_prepend_elem||5.013006|
++op_refcnt_dec|||
++op_refcnt_inc|||
++op_refcnt_lock||5.009002|
++op_refcnt_unlock||5.009002|
++op_scope||5.013007|
++op_std_init|||
++op_unscope|||
++op_xmldump|||
++open_script|||
++opslab_force_free|||
++opslab_free_nopad|||
++opslab_free|||
++pMY_CXT_|5.007003||p
++pMY_CXT|5.007003||p
++pTHX_|5.006000||p
++pTHX|5.006000||p
++packWARN|5.007003||p
++pack_cat||5.007003|
++pack_rec|||
++package_version|||
++package|||
++packlist||5.008001|
++pad_add_anon||5.008001|
++pad_add_name_pvn||5.015001|
++pad_add_name_pvs||5.015001|
++pad_add_name_pv||5.015001|
++pad_add_name_sv||5.015001|
++pad_alloc_name|||
++pad_alloc|||
++pad_block_start|||
++pad_check_dup|||
++pad_compname_type||5.009003|
++pad_findlex|||
++pad_findmy_pvn||5.015001|
++pad_findmy_pvs||5.015001|
++pad_findmy_pv||5.015001|
++pad_findmy_sv||5.015001|
++pad_fixup_inner_anons|||
++pad_free|||
++pad_leavemy|||
++pad_new||5.008001|
++pad_peg|||n
++pad_push|||
++pad_reset|||
++pad_setsv|||
++pad_sv|||
++pad_swipe|||
++pad_tidy||5.008001|
++padlist_dup|||
++padlist_store|||
++parse_arithexpr||5.013008|
++parse_barestmt||5.013007|
++parse_block||5.013007|
++parse_body|||
++parse_fullexpr||5.013008|
++parse_fullstmt||5.013005|
++parse_ident|||
++parse_label||5.013007|
++parse_listexpr||5.013008|
++parse_lparen_question_flags|||
++parse_stmtseq||5.013006|
++parse_termexpr||5.013008|
++parse_unicode_opts|||
++parser_dup|||
++parser_free_nexttoke_ops|||
++parser_free|||
++path_is_searchable|||n
++peep|||
++pending_ident|||
++perl_alloc_using|||n
++perl_alloc|||n
++perl_clone_using|||n
++perl_clone|||n
++perl_construct|||n
++perl_destruct||5.007003|n
++perl_free|||n
++perl_parse||5.006000|n
++perl_run|||n
++pidgone|||
++pm_description|||
++pmop_dump||5.006000|
++pmop_xmldump|||
++pmruntime|||
++pmtrans|||
++pop_scope|||
++populate_isa|||v
++pregcomp||5.009005|
++pregexec|||
++pregfree2||5.011000|
++pregfree|||
++prepend_madprops|||
++prescan_version||5.011004|
++printbuf|||
++printf_nocontext|||vn
++process_special_blocks|||
++ptr_hash|||n
++ptr_table_clear||5.009005|
++ptr_table_fetch||5.009005|
++ptr_table_find|||n
++ptr_table_free||5.009005|
++ptr_table_new||5.009005|
++ptr_table_split||5.009005|
++ptr_table_store||5.009005|
++push_scope|||
++put_byte|||
++put_latin1_charclass_innards|||
++pv_display|5.006000||p
++pv_escape|5.009004||p
++pv_pretty|5.009004||p
++pv_uni_display||5.007003|
++qerror|||
++qsortsvu|||
++re_compile||5.009005|
++re_croak2|||
++re_dup_guts|||
++re_intuit_start||5.019001|
++re_intuit_string||5.006000|
++re_op_compile|||
++readpipe_override|||
++realloc||5.007002|n
++reentrant_free||5.019003|
++reentrant_init||5.019003|
++reentrant_retry||5.019003|vn
++reentrant_size||5.019003|
++ref_array_or_hash|||
++refcounted_he_chain_2hv|||
++refcounted_he_fetch_pvn|||
++refcounted_he_fetch_pvs|||
++refcounted_he_fetch_pv|||
++refcounted_he_fetch_sv|||
++refcounted_he_free|||
++refcounted_he_inc|||
++refcounted_he_new_pvn|||
++refcounted_he_new_pvs|||
++refcounted_he_new_pv|||
++refcounted_he_new_sv|||
++refcounted_he_value|||
++refkids|||
++refto|||
++ref||5.019003|
++reg_check_named_buff_matched|||
++reg_named_buff_all||5.009005|
++reg_named_buff_exists||5.009005|
++reg_named_buff_fetch||5.009005|
++reg_named_buff_firstkey||5.009005|
++reg_named_buff_iter|||
++reg_named_buff_nextkey||5.009005|
++reg_named_buff_scalar||5.009005|
++reg_named_buff|||
++reg_node|||
++reg_numbered_buff_fetch|||
++reg_numbered_buff_length|||
++reg_numbered_buff_store|||
++reg_qr_package|||
++reg_recode|||
++reg_scan_name|||
++reg_skipcomment|||
++reg_temp_copy|||
++reganode|||
++regatom|||
++regbranch|||
++regclass_swash||5.009004|
++regclass|||
++regcppop|||
++regcppush|||
++regcurly|||
++regdump_extflags|||
++regdump_intflags|||
++regdump||5.005000|
++regdupe_internal|||
++regexec_flags||5.005000|
++regfree_internal||5.009005|
++reghop3|||n
++reghop4|||n
++reghopmaybe3|||n
++reginclass|||
++reginitcolors||5.006000|
++reginsert|||
++regmatch|||
++regnext||5.005000|
++regpatws|||n
++regpiece|||
++regpposixcc|||
++regprop|||
++regrepeat|||
++regtail_study|||
++regtail|||
++regtry|||
++reguni|||
++regwhite|||n
++reg|||
++repeatcpy|||n
++report_evil_fh|||
++report_redefined_cv|||
++report_uninit|||
++report_wrongway_fh|||
++require_pv||5.006000|
++require_tie_mod|||
++restore_magic|||
++rninstr|||n
++rpeep|||
++rsignal_restore|||
++rsignal_save|||
++rsignal_state||5.004000|
++rsignal||5.004000|
++run_body|||
++run_user_filter|||
++runops_debug||5.005000|
++runops_standard||5.005000|
++rv2cv_op_cv||5.013006|
++rvpv_dup|||
++rxres_free|||
++rxres_restore|||
++rxres_save|||
++safesyscalloc||5.006000|n
++safesysfree||5.006000|n
++safesysmalloc||5.006000|n
++safesysrealloc||5.006000|n
++same_dirent|||
++save_I16||5.004000|
++save_I32|||
++save_I8||5.006000|
++save_adelete||5.011000|
++save_aelem_flags||5.011000|
++save_aelem||5.004050|
++save_alloc||5.006000|
++save_aptr|||
++save_ary|||
++save_bool||5.008001|
++save_clearsv|||
++save_delete|||
++save_destructor_x||5.006000|
++save_destructor||5.006000|
++save_freeop|||
++save_freepv|||
++save_freesv|||
++save_generic_pvref||5.006001|
++save_generic_svref||5.005030|
++save_gp||5.004000|
++save_hash|||
++save_hdelete||5.011000|
++save_hek_flags|||n
++save_helem_flags||5.011000|
++save_helem||5.004050|
++save_hints||5.010001|
++save_hptr|||
++save_int|||
++save_item|||
++save_iv||5.005000|
++save_lines|||
++save_list|||
++save_long|||
++save_magic_flags|||
++save_mortalizesv||5.007001|
++save_nogv|||
++save_op||5.005000|
++save_padsv_and_mortalize||5.010001|
++save_pptr|||
++save_pushi32ptr||5.010001|
++save_pushptri32ptr|||
++save_pushptrptr||5.010001|
++save_pushptr||5.010001|
++save_re_context||5.006000|
++save_scalar_at|||
++save_scalar|||
++save_set_svflags||5.009000|
++save_shared_pvref||5.007003|
++save_sptr|||
++save_svref|||
++save_vptr||5.006000|
++savepvn|||
++savepvs||5.009003|
++savepv|||
++savesharedpvn||5.009005|
++savesharedpvs||5.013006|
++savesharedpv||5.007003|
++savesharedsvpv||5.013006|
++savestack_grow_cnt||5.008001|
++savestack_grow|||
++savesvpv||5.009002|
++sawparens|||
++scalar_mod_type|||n
++scalarboolean|||
++scalarkids|||
++scalarseq|||
++scalarvoid|||
++scalar|||
++scan_bin||5.006000|
++scan_commit|||
++scan_const|||
++scan_formline|||
++scan_heredoc|||
++scan_hex|||
++scan_ident|||
++scan_inputsymbol|||
++scan_num||5.007001|
++scan_oct|||
++scan_pat|||
++scan_str|||
++scan_subst|||
++scan_trans|||
++scan_version||5.009001|
++scan_vstring||5.009005|
++scan_word|||
++screaminstr||5.005000|
++search_const|||
++seed||5.008001|
++sequence_num|||
++set_context||5.006000|n
++set_numeric_local||5.006000|
++set_numeric_radix||5.006000|
++set_numeric_standard||5.006000|
++setdefout|||
++share_hek_flags|||
++share_hek||5.004000|
++si_dup|||
++sighandler|||n
++simplify_sort|||
++skipspace0|||
++skipspace1|||
++skipspace2|||
++skipspace_flags|||
++softref2xv|||
++sortcv_stacked|||
++sortcv_xsub|||
++sortcv|||
++sortsv_flags||5.009003|
++sortsv||5.007003|
++space_join_names_mortal|||
++ss_dup|||
++stack_grow|||
++start_force|||
++start_glob|||
++start_subparse||5.004000|
++stdize_locale|||
++strEQ|||
++strGE|||
++strGT|||
++strLE|||
++strLT|||
++strNE|||
++str_to_version||5.006000|
++strip_return|||
++strnEQ|||
++strnNE|||
++study_chunk|||
++sub_crush_depth|||
++sublex_done|||
++sublex_push|||
++sublex_start|||
++sv_2bool_flags||5.013006|
++sv_2bool|||
++sv_2cv|||
++sv_2io|||
++sv_2iuv_common|||
++sv_2iuv_non_preserve|||
++sv_2iv_flags||5.009001|
++sv_2iv|||
++sv_2mortal|||
++sv_2num|||
++sv_2nv_flags||5.013001|
++sv_2pv_flags|5.007002||p
++sv_2pv_nolen|5.006000||p
++sv_2pvbyte_nolen|5.006000||p
++sv_2pvbyte|5.006000||p
++sv_2pvutf8_nolen||5.006000|
++sv_2pvutf8||5.006000|
++sv_2pv|||
++sv_2uv_flags||5.009001|
++sv_2uv|5.004000||p
++sv_add_arena|||
++sv_add_backref|||
++sv_backoff|||
++sv_bless|||
++sv_cat_decode||5.008001|
++sv_catpv_flags||5.013006|
++sv_catpv_mg|5.004050||p
++sv_catpv_nomg||5.013006|
++sv_catpvf_mg_nocontext|||pvn
++sv_catpvf_mg|5.006000|5.004000|pv
++sv_catpvf_nocontext|||vn
++sv_catpvf||5.004000|v
++sv_catpvn_flags||5.007002|
++sv_catpvn_mg|5.004050||p
++sv_catpvn_nomg|5.007002||p
++sv_catpvn|||
++sv_catpvs_flags||5.013006|
++sv_catpvs_mg||5.013006|
++sv_catpvs_nomg||5.013006|
++sv_catpvs|5.009003||p
++sv_catpv|||
++sv_catsv_flags||5.007002|
++sv_catsv_mg|5.004050||p
++sv_catsv_nomg|5.007002||p
++sv_catsv|||
++sv_catxmlpvn|||
++sv_catxmlpv|||
++sv_catxmlsv|||
++sv_chop|||
++sv_clean_all|||
++sv_clean_objs|||
++sv_clear|||
++sv_cmp_flags||5.013006|
++sv_cmp_locale_flags||5.013006|
++sv_cmp_locale||5.004000|
++sv_cmp|||
++sv_collxfrm_flags||5.013006|
++sv_collxfrm|||
++sv_copypv_flags||5.017002|
++sv_copypv_nomg||5.017002|
++sv_copypv|||
++sv_dec_nomg||5.013002|
++sv_dec|||
++sv_del_backref|||
++sv_derived_from_pvn||5.015004|
++sv_derived_from_pv||5.015004|
++sv_derived_from_sv||5.015004|
++sv_derived_from||5.004000|
++sv_destroyable||5.010000|
++sv_display|||
++sv_does_pvn||5.015004|
++sv_does_pv||5.015004|
++sv_does_sv||5.015004|
++sv_does||5.009004|
++sv_dump|||
++sv_dup_common|||
++sv_dup_inc_multiple|||
++sv_dup_inc|||
++sv_dup|||
++sv_eq_flags||5.013006|
++sv_eq|||
++sv_exp_grow|||
++sv_force_normal_flags||5.007001|
++sv_force_normal||5.006000|
++sv_free2|||
++sv_free_arenas|||
++sv_free|||
++sv_gets||5.004000|
++sv_grow|||
++sv_i_ncmp|||
++sv_inc_nomg||5.013002|
++sv_inc|||
++sv_insert_flags||5.010001|
++sv_insert|||
++sv_isa|||
++sv_isobject|||
++sv_iv||5.005000|
++sv_kill_backrefs|||
++sv_len_utf8_nomg|||
++sv_len_utf8||5.006000|
++sv_len|||
++sv_magic_portable|5.019003|5.004000|p
++sv_magicext_mglob|||
++sv_magicext||5.007003|
++sv_magic|||
++sv_mortalcopy_flags|||
++sv_mortalcopy|||
++sv_ncmp|||
++sv_newmortal|||
++sv_newref|||
++sv_nolocking||5.007003|
++sv_nosharing||5.007003|
++sv_nounlocking|||
++sv_nv||5.005000|
++sv_peek||5.005000|
++sv_pos_b2u_flags||5.019003|
++sv_pos_b2u_midway|||
++sv_pos_b2u||5.006000|
++sv_pos_u2b_cached|||
++sv_pos_u2b_flags||5.011005|
++sv_pos_u2b_forwards|||n
++sv_pos_u2b_midway|||n
++sv_pos_u2b||5.006000|
++sv_pvbyten_force||5.006000|
++sv_pvbyten||5.006000|
++sv_pvbyte||5.006000|
++sv_pvn_force_flags|5.007002||p
++sv_pvn_force|||
++sv_pvn_nomg|5.007003|5.005000|p
++sv_pvn||5.005000|
++sv_pvutf8n_force||5.006000|
++sv_pvutf8n||5.006000|
++sv_pvutf8||5.006000|
++sv_pv||5.006000|
++sv_recode_to_utf8||5.007003|
++sv_reftype|||
++sv_ref|||
++sv_release_COW|||
++sv_replace|||
++sv_report_used|||
++sv_resetpvn|||
++sv_reset|||
++sv_rvweaken||5.006000|
++sv_sethek|||
++sv_setiv_mg|5.004050||p
++sv_setiv|||
++sv_setnv_mg|5.006000||p
++sv_setnv|||
++sv_setpv_mg|5.004050||p
++sv_setpvf_mg_nocontext|||pvn
++sv_setpvf_mg|5.006000|5.004000|pv
++sv_setpvf_nocontext|||vn
++sv_setpvf||5.004000|v
++sv_setpviv_mg||5.008001|
++sv_setpviv||5.008001|
++sv_setpvn_mg|5.004050||p
++sv_setpvn|||
++sv_setpvs_mg||5.013006|
++sv_setpvs|5.009004||p
++sv_setpv|||
++sv_setref_iv|||
++sv_setref_nv|||
++sv_setref_pvn|||
++sv_setref_pvs||5.019003|
++sv_setref_pv|||
++sv_setref_uv||5.007001|
++sv_setsv_cow|||
++sv_setsv_flags||5.007002|
++sv_setsv_mg|5.004050||p
++sv_setsv_nomg|5.007002||p
++sv_setsv|||
++sv_setuv_mg|5.004050||p
++sv_setuv|5.004000||p
++sv_tainted||5.004000|
++sv_taint||5.004000|
++sv_true||5.005000|
++sv_unglob|||
++sv_uni_display||5.007003|
++sv_unmagicext||5.013008|
++sv_unmagic|||
++sv_unref_flags||5.007001|
++sv_unref|||
++sv_untaint||5.004000|
++sv_upgrade|||
++sv_usepvn_flags||5.009004|
++sv_usepvn_mg|5.004050||p
++sv_usepvn|||
++sv_utf8_decode||5.006000|
++sv_utf8_downgrade||5.006000|
++sv_utf8_encode||5.006000|
++sv_utf8_upgrade_flags_grow||5.011000|
++sv_utf8_upgrade_flags||5.007002|
++sv_utf8_upgrade_nomg||5.007002|
++sv_utf8_upgrade||5.007001|
++sv_uv|5.005000||p
++sv_vcatpvf_mg|5.006000|5.004000|p
++sv_vcatpvfn_flags||5.017002|
++sv_vcatpvfn||5.004000|
++sv_vcatpvf|5.006000|5.004000|p
++sv_vsetpvf_mg|5.006000|5.004000|p
++sv_vsetpvfn||5.004000|
++sv_vsetpvf|5.006000|5.004000|p
++sv_xmlpeek|||
++svtype|||
++swallow_bom|||
++swash_fetch||5.007002|
++swash_init||5.006000|
++swatch_get|||
++sys_init3||5.010000|n
++sys_init||5.010000|n
++sys_intern_clear|||
++sys_intern_dup|||
++sys_intern_init|||
++sys_term||5.010000|n
++taint_env|||
++taint_proper|||
++tied_method|||v
++tmps_grow||5.006000|
++toFOLD_uni||5.007003|
++toFOLD_utf8||5.019001|
++toFOLD||5.019001|
++toLOWER_L1||5.019001|
++toLOWER_LC||5.004000|
++toLOWER_uni||5.007003|
++toLOWER_utf8||5.015007|
++toLOWER|||
++toTITLE_uni||5.007003|
++toTITLE_utf8||5.015007|
++toTITLE||5.019001|
++toUPPER_uni||5.007003|
++toUPPER_utf8||5.015007|
++toUPPER||5.004000|
++to_byte_substr|||
++to_lower_latin1|||
++to_uni_fold||5.007003|
++to_uni_lower_lc||5.006000|
++to_uni_lower||5.007003|
++to_uni_title_lc||5.006000|
++to_uni_title||5.007003|
++to_uni_upper_lc||5.006000|
++to_uni_upper||5.007003|
++to_utf8_case||5.007003|
++to_utf8_fold||5.015007|
++to_utf8_lower||5.015007|
++to_utf8_substr|||
++to_utf8_title||5.015007|
++to_utf8_upper||5.015007|
++token_free|||
++token_getmad|||
++tokenize_use|||
++tokeq|||
++tokereport|||
++too_few_arguments_pv|||
++too_few_arguments_sv|||
++too_many_arguments_pv|||
++too_many_arguments_sv|||
++translate_substr_offsets|||
++try_amagic_bin|||
++try_amagic_un|||
++uiv_2buf|||n
++unlnk|||
++unpack_rec|||
++unpack_str||5.007003|
++unpackstring||5.008001|
++unreferenced_to_tmp_stack|||
++unshare_hek_or_pvn|||
++unshare_hek|||
++unsharepvn||5.004000|
++unwind_handler_stack|||
++update_debugger_info|||
++upg_version||5.009005|
++usage|||
++utf16_textfilter|||
++utf16_to_utf8_reversed||5.006001|
++utf16_to_utf8||5.006001|
++utf8_distance||5.006000|
++utf8_hop||5.006000|
++utf8_length||5.007001|
++utf8_mg_len_cache_update|||
++utf8_mg_pos_cache_update|||
++utf8_to_bytes||5.006001|
++utf8_to_uvchr_buf||5.015009|
++utf8_to_uvchr||5.007001|
++utf8_to_uvuni_buf||5.015009|
++utf8_to_uvuni||5.007001|
++utf8n_to_uvchr|||
++utf8n_to_uvuni||5.007001|
++utilize|||
++uvchr_to_utf8_flags||5.007003|
++uvchr_to_utf8|||
++uvuni_to_utf8_flags||5.007003|
++uvuni_to_utf8||5.007001|
++valid_utf8_to_uvchr|||
++valid_utf8_to_uvuni||5.015009|
++validate_proto|||
++validate_suid|||
++varname|||
++vcmp||5.009000|
++vcroak||5.006000|
++vdeb||5.007003|
++vform||5.006000|
++visit|||
++vivify_defelem|||
++vivify_ref|||
++vload_module|5.006000||p
++vmess||5.006000|
++vnewSVpvf|5.006000|5.004000|p
++vnormal||5.009002|
++vnumify||5.009000|
++vstringify||5.009000|
++vverify||5.009003|
++vwarner||5.006000|
++vwarn||5.006000|
++wait4pid|||
++warn_nocontext|||vn
++warn_sv||5.013001|
++warner_nocontext|||vn
++warner|5.006000|5.004000|pv
++warn|||v
++was_lvalue_sub|||
++watch|||
++whichsig_pvn||5.015004|
++whichsig_pv||5.015004|
++whichsig_sv||5.015004|
++whichsig|||
++win32_croak_not_implemented|||n
++with_queued_errors|||
++wrap_op_checker||5.015008|
++write_to_stderr|||
++xmldump_all_perl|||
++xmldump_all|||
++xmldump_attr|||
++xmldump_eval|||
++xmldump_form|||
++xmldump_indent|||v
++xmldump_packsubs_perl|||
++xmldump_packsubs|||
++xmldump_sub_perl|||
++xmldump_sub|||
++xmldump_vindent|||
++xs_apiversion_bootcheck|||
++xs_version_bootcheck|||
++yyerror_pvn|||
++yyerror_pv|||
++yyerror|||
++yylex|||
++yyparse|||
++yyunlex|||
++yywarn|||
++);
++
++if (exists $opt{'list-unsupported'}) {
++ my $f;
++ for $f (sort { lc $a cmp lc $b } keys %API) {
++ next unless $API{$f}{todo};
++ print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
++ }
++ exit 0;
++}
++
++# Scan for possible replacement candidates
++
++my(%replace, %need, %hints, %warnings, %depends);
++my $replace = 0;
++my($hint, $define, $function);
++
++sub find_api
++{
++ my $code = shift;
++ $code =~ s{
++ / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
++ | "[^"\\]*(?:\\.[^"\\]*)*"
++ | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
++ grep { exists $API{$_} } $code =~ /(\w+)/mg;
++}
++
++while (<DATA>) {
++ if ($hint) {
++ my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
++ if (m{^\s*\*\s(.*?)\s*$}) {
++ for (@{$hint->[1]}) {
++ $h->{$_} ||= ''; # suppress warning with older perls
++ $h->{$_} .= "$1\n";
++ }
++ }
++ else { undef $hint }
++ }
++
++ $hint = [$1, [split /,?\s+/, $2]]
++ if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
++
++ if ($define) {
++ if ($define->[1] =~ /\\$/) {
++ $define->[1] .= $_;
++ }
++ else {
++ if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
++ my @n = find_api($define->[1]);
++ push @{$depends{$define->[0]}}, @n if @n
++ }
++ undef $define;
++ }
++ }
++
++ $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
++
++ if ($function) {
++ if (/^}/) {
++ if (exists $API{$function->[0]}) {
++ my @n = find_api($function->[1]);
++ push @{$depends{$function->[0]}}, @n if @n
++ }
++ undef $function;
++ }
++ else {
++ $function->[1] .= $_;
++ }
++ }
++
++ $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
++
++ $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
++ $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
++ $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
++ $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
++
++ if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
++ my @deps = map { s/\s+//g; $_ } split /,/, $3;
++ my $d;
++ for $d (map { s/\s+//g; $_ } split /,/, $1) {
++ push @{$depends{$d}}, @deps;
++ }
++ }
++
++ $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
++}
++
++for (values %depends) {
++ my %s;
++ $_ = [sort grep !$s{$_}++, @$_];
++}
++
++if (exists $opt{'api-info'}) {
++ my $f;
++ my $count = 0;
++ my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
++ for $f (sort { lc $a cmp lc $b } keys %API) {
++ next unless $f =~ /$match/;
++ print "\n=== $f ===\n\n";
++ my $info = 0;
++ if ($API{$f}{base} || $API{$f}{todo}) {
++ my $base = format_version($API{$f}{base} || $API{$f}{todo});
++ print "Supported at least starting from perl-$base.\n";
++ $info++;
++ }
++ if ($API{$f}{provided}) {
++ my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
++ print "Support by $ppport provided back to perl-$todo.\n";
++ print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
++ print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
++ print "\n$hints{$f}" if exists $hints{$f};
++ print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
++ $info++;
++ }
++ print "No portability information available.\n" unless $info;
++ $count++;
++ }
++ $count or print "Found no API matching '$opt{'api-info'}'.";
++ print "\n";
++ exit 0;
++}
++
++if (exists $opt{'list-provided'}) {
++ my $f;
++ for $f (sort { lc $a cmp lc $b } keys %API) {
++ next unless $API{$f}{provided};
++ my @flags;
++ push @flags, 'explicit' if exists $need{$f};
++ push @flags, 'depend' if exists $depends{$f};
++ push @flags, 'hint' if exists $hints{$f};
++ push @flags, 'warning' if exists $warnings{$f};
++ my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
++ print "$f$flags\n";
++ }
++ exit 0;
++}
++
++my @files;
++my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
++my $srcext = join '|', map { quotemeta $_ } @srcext;
++
++if (@ARGV) {
++ my %seen;
++ for (@ARGV) {
++ if (-e) {
++ if (-f) {
++ push @files, $_ unless $seen{$_}++;
++ }
++ else { warn "'$_' is not a file.\n" }
++ }
++ else {
++ my @new = grep { -f } glob $_
++ or warn "'$_' does not exist.\n";
++ push @files, grep { !$seen{$_}++ } @new;
++ }
++ }
++}
++else {
++ eval {
++ require File::Find;
++ File::Find::find(sub {
++ $File::Find::name =~ /($srcext)$/i
++ and push @files, $File::Find::name;
++ }, '.');
++ };
++ if ($@) {
++ @files = map { glob "*$_" } @srcext;
++ }
++}
++
++if (!@ARGV || $opt{filter}) {
++ my(@in, @out);
++ my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
++ for (@files) {
++ my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
++ push @{ $out ? \@out : \@in }, $_;
++ }
++ if (@ARGV && @out) {
++ warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
++ }
++ @files = @in;
++}
++
++die "No input files given!\n" unless @files;
++
++my(%files, %global, %revreplace);
++%revreplace = reverse %replace;
++my $filename;
++my $patch_opened = 0;
++
++for $filename (@files) {
++ unless (open IN, "<$filename") {
++ warn "Unable to read from $filename: $!\n";
++ next;
++ }
++
++ info("Scanning $filename ...");
++
++ my $c = do { local $/; <IN> };
++ close IN;
++
++ my %file = (orig => $c, changes => 0);
++
++ # Temporarily remove C/XS comments and strings from the code
++ my @ccom;
++
++ $c =~ s{
++ ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
++ | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
++ | ( ^$HS*\#[^\r\n]*
++ | "[^"\\]*(?:\\.[^"\\]*)*"
++ | '[^'\\]*(?:\\.[^'\\]*)*'
++ | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
++ }{ defined $2 and push @ccom, $2;
++ defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
++
++ $file{ccom} = \@ccom;
++ $file{code} = $c;
++ $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
++
++ my $func;
++
++ for $func (keys %API) {
++ my $match = $func;
++ $match .= "|$revreplace{$func}" if exists $revreplace{$func};
++ if ($c =~ /\b(?:Perl_)?($match)\b/) {
++ $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
++ $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
++ if (exists $API{$func}{provided}) {
++ $file{uses_provided}{$func}++;
++ if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
++ $file{uses}{$func}++;
++ my @deps = rec_depend($func);
++ if (@deps) {
++ $file{uses_deps}{$func} = \@deps;
++ for (@deps) {
++ $file{uses}{$_} = 0 unless exists $file{uses}{$_};
++ }
++ }
++ for ($func, @deps) {
++ $file{needs}{$_} = 'static' if exists $need{$_};
++ }
++ }
++ }
++ if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
++ if ($c =~ /\b$func\b/) {
++ $file{uses_todo}{$func}++;
++ }
++ }
++ }
++ }
++
++ while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
++ if (exists $need{$2}) {
++ $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
++ }
++ else { warning("Possibly wrong #define $1 in $filename") }
++ }
++
++ for (qw(uses needs uses_todo needed_global needed_static)) {
++ for $func (keys %{$file{$_}}) {
++ push @{$global{$_}{$func}}, $filename;
++ }
++ }
++
++ $files{$filename} = \%file;
++}
++
++# Globally resolve NEED_'s
++my $need;
++for $need (keys %{$global{needs}}) {
++ if (@{$global{needs}{$need}} > 1) {
++ my @targets = @{$global{needs}{$need}};
++ my @t = grep $files{$_}{needed_global}{$need}, @targets;
++ @targets = @t if @t;
++ @t = grep /\.xs$/i, @targets;
++ @targets = @t if @t;
++ my $target = shift @targets;
++ $files{$target}{needs}{$need} = 'global';
++ for (@{$global{needs}{$need}}) {
++ $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
++ }
++ }
++}
++
++for $filename (@files) {
++ exists $files{$filename} or next;
++
++ info("=== Analyzing $filename ===");
++
++ my %file = %{$files{$filename}};
++ my $func;
++ my $c = $file{code};
++ my $warnings = 0;
++
++ for $func (sort keys %{$file{uses_Perl}}) {
++ if ($API{$func}{varargs}) {
++ unless ($API{$func}{nothxarg}) {
++ my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
++ { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
++ if ($changes) {
++ warning("Doesn't pass interpreter argument aTHX to Perl_$func");
++ $file{changes} += $changes;
++ }
++ }
++ }
++ else {
++ warning("Uses Perl_$func instead of $func");
++ $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
++ {$func$1(}g);
++ }
++ }
++
++ for $func (sort keys %{$file{uses_replace}}) {
++ warning("Uses $func instead of $replace{$func}");
++ $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
++ }
++
++ for $func (sort keys %{$file{uses_provided}}) {
++ if ($file{uses}{$func}) {
++ if (exists $file{uses_deps}{$func}) {
++ diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
++ }
++ else {
++ diag("Uses $func");
++ }
++ }
++ $warnings += hint($func);
++ }
++
++ unless ($opt{quiet}) {
++ for $func (sort keys %{$file{uses_todo}}) {
++ print "*** WARNING: Uses $func, which may not be portable below perl ",
++ format_version($API{$func}{todo}), ", even with '$ppport'\n";
++ $warnings++;
++ }
++ }
++
++ for $func (sort keys %{$file{needed_static}}) {
++ my $message = '';
++ if (not exists $file{uses}{$func}) {
++ $message = "No need to define NEED_$func if $func is never used";
++ }
++ elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
++ $message = "No need to define NEED_$func when already needed globally";
++ }
++ if ($message) {
++ diag($message);
++ $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
++ }
++ }
++
++ for $func (sort keys %{$file{needed_global}}) {
++ my $message = '';
++ if (not exists $global{uses}{$func}) {
++ $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
++ }
++ elsif (exists $file{needs}{$func}) {
++ if ($file{needs}{$func} eq 'extern') {
++ $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
++ }
++ elsif ($file{needs}{$func} eq 'static') {
++ $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
++ }
++ }
++ if ($message) {
++ diag($message);
++ $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
++ }
++ }
++
++ $file{needs_inc_ppport} = keys %{$file{uses}};
++
++ if ($file{needs_inc_ppport}) {
++ my $pp = '';
++
++ for $func (sort keys %{$file{needs}}) {
++ my $type = $file{needs}{$func};
++ next if $type eq 'extern';
++ my $suffix = $type eq 'global' ? '_GLOBAL' : '';
++ unless (exists $file{"needed_$type"}{$func}) {
++ if ($type eq 'global') {
++ diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
++ }
++ else {
++ diag("File needs $func, adding static request");
++ }
++ $pp .= "#define NEED_$func$suffix\n";
++ }
++ }
++
++ if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
++ $pp = '';
++ $file{changes}++;
++ }
++
++ unless ($file{has_inc_ppport}) {
++ diag("Needs to include '$ppport'");
++ $pp .= qq(#include "$ppport"\n)
++ }
++
++ if ($pp) {
++ $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
++ || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
++ || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
++ || ($c =~ s/^/$pp/);
++ }
++ }
++ else {
++ if ($file{has_inc_ppport}) {
++ diag("No need to include '$ppport'");
++ $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
++ }
++ }
++
++ # put back in our C comments
++ my $ix;
++ my $cppc = 0;
++ my @ccom = @{$file{ccom}};
++ for $ix (0 .. $#ccom) {
++ if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
++ $cppc++;
++ $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
++ }
++ else {
++ $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
++ }
++ }
++
++ if ($cppc) {
++ my $s = $cppc != 1 ? 's' : '';
++ warning("Uses $cppc C++ style comment$s, which is not portable");
++ }
++
++ my $s = $warnings != 1 ? 's' : '';
++ my $warn = $warnings ? " ($warnings warning$s)" : '';
++ info("Analysis completed$warn");
++
++ if ($file{changes}) {
++ if (exists $opt{copy}) {
++ my $newfile = "$filename$opt{copy}";
++ if (-e $newfile) {
++ error("'$newfile' already exists, refusing to write copy of '$filename'");
++ }
++ else {
++ local *F;
++ if (open F, ">$newfile") {
++ info("Writing copy of '$filename' with changes to '$newfile'");
++ print F $c;
++ close F;
++ }
++ else {
++ error("Cannot open '$newfile' for writing: $!");
++ }
++ }
++ }
++ elsif (exists $opt{patch} || $opt{changes}) {
++ if (exists $opt{patch}) {
++ unless ($patch_opened) {
++ if (open PATCH, ">$opt{patch}") {
++ $patch_opened = 1;
++ }
++ else {
++ error("Cannot open '$opt{patch}' for writing: $!");
++ delete $opt{patch};
++ $opt{changes} = 1;
++ goto fallback;
++ }
++ }
++ mydiff(\*PATCH, $filename, $c);
++ }
++ else {
++fallback:
++ info("Suggested changes:");
++ mydiff(\*STDOUT, $filename, $c);
++ }
++ }
++ else {
++ my $s = $file{changes} == 1 ? '' : 's';
++ info("$file{changes} potentially required change$s detected");
++ }
++ }
++ else {
++ info("Looks good");
++ }
++}
++
++close PATCH if $patch_opened;
++
++exit 0;
++
++
++sub try_use { eval "use @_;"; return $@ eq '' }
++
++sub mydiff
++{
++ local *F = shift;
++ my($file, $str) = @_;
++ my $diff;
++
++ if (exists $opt{diff}) {
++ $diff = run_diff($opt{diff}, $file, $str);
++ }
++
++ if (!defined $diff and try_use('Text::Diff')) {
++ $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
++ $diff = <<HEADER . $diff;
++--- $file
+++++ $file.patched
++HEADER
++ }
++
++ if (!defined $diff) {
++ $diff = run_diff('diff -u', $file, $str);
++ }
++
++ if (!defined $diff) {
++ $diff = run_diff('diff', $file, $str);
++ }
++
++ if (!defined $diff) {
++ error("Cannot generate a diff. Please install Text::Diff or use --copy.");
++ return;
++ }
++
++ print F $diff;
++}
++
++sub run_diff
++{
++ my($prog, $file, $str) = @_;
++ my $tmp = 'dppptemp';
++ my $suf = 'aaa';
++ my $diff = '';
++ local *F;
++
++ while (-e "$tmp.$suf") { $suf++ }
++ $tmp = "$tmp.$suf";
++
++ if (open F, ">$tmp") {
++ print F $str;
++ close F;
++
++ if (open F, "$prog $file $tmp |") {
++ while (<F>) {
++ s/\Q$tmp\E/$file.patched/;
++ $diff .= $_;
++ }
++ close F;
++ unlink $tmp;
++ return $diff;
++ }
++
++ unlink $tmp;
++ }
++ else {
++ error("Cannot open '$tmp' for writing: $!");
++ }
++
++ return undef;
++}
++
++sub rec_depend
++{
++ my($func, $seen) = @_;
++ return () unless exists $depends{$func};
++ $seen = {%{$seen||{}}};
++ return () if $seen->{$func}++;
++ my %s;
++ grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
++}
++
++sub parse_version
++{
++ my $ver = shift;
++
++ if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
++ return ($1, $2, $3);
++ }
++ elsif ($ver !~ /^\d+\.[\d_]+$/) {
++ die "cannot parse version '$ver'\n";
++ }
++
++ $ver =~ s/_//g;
++ $ver =~ s/$/000000/;
++
++ my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
++
++ $v = int $v;
++ $s = int $s;
++
++ if ($r < 5 || ($r == 5 && $v < 6)) {
++ if ($s % 10) {
++ die "cannot parse version '$ver'\n";
++ }
++ }
++
++ return ($r, $v, $s);
++}
++
++sub format_version
++{
++ my $ver = shift;
++
++ $ver =~ s/$/000000/;
++ my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
++
++ $v = int $v;
++ $s = int $s;
++
++ if ($r < 5 || ($r == 5 && $v < 6)) {
++ if ($s % 10) {
++ die "invalid version '$ver'\n";
++ }
++ $s /= 10;
++
++ $ver = sprintf "%d.%03d", $r, $v;
++ $s > 0 and $ver .= sprintf "_%02d", $s;
++
++ return $ver;
++ }
++
++ return sprintf "%d.%d.%d", $r, $v, $s;
++}
++
++sub info
++{
++ $opt{quiet} and return;
++ print @_, "\n";
++}
++
++sub diag
++{
++ $opt{quiet} and return;
++ $opt{diag} and print @_, "\n";
++}
++
++sub warning
++{
++ $opt{quiet} and return;
++ print "*** ", @_, "\n";
++}
++
++sub error
++{
++ print "*** ERROR: ", @_, "\n";
++}
++
++my %given_hints;
++my %given_warnings;
++sub hint
++{
++ $opt{quiet} and return;
++ my $func = shift;
++ my $rv = 0;
++ if (exists $warnings{$func} && !$given_warnings{$func}++) {
++ my $warn = $warnings{$func};
++ $warn =~ s!^!*** !mg;
++ print "*** WARNING: $func\n", $warn;
++ $rv++;
++ }
++ if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
++ my $hint = $hints{$func};
++ $hint =~ s/^/ /mg;
++ print " --- hint for $func ---\n", $hint;
++ }
++ $rv;
++}
++
++sub usage
++{
++ my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
++ my %M = ( 'I' => '*' );
++ $usage =~ s/^\s*perl\s+\S+/$^X $0/;
++ $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
++
++ print <<ENDUSAGE;
++
++Usage: $usage
++
++See perldoc $0 for details.
++
++ENDUSAGE
++
++ exit 2;
++}
++
++sub strip
++{
++ my $self = do { local(@ARGV,$/)=($0); <> };
++ my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
++ $copy =~ s/^(?=\S+)/ /gms;
++ $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
++ $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
++if (\@ARGV && \$ARGV[0] eq '--unstrip') {
++ eval { require Devel::PPPort };
++ \$@ and die "Cannot require Devel::PPPort, please install.\\n";
++ if (eval \$Devel::PPPort::VERSION < $VERSION) {
++ die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
++ . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
++ . "Please install a newer version, or --unstrip will not work.\\n";
++ }
++ Devel::PPPort::WriteFile(\$0);
++ exit 0;
++}
++print <<END;
++
++Sorry, but this is a stripped version of \$0.
++
++To be able to use its original script and doc functionality,
++please try to regenerate this file using:
++
++ \$^X \$0 --unstrip
++
++END
++/ms;
++ my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
++ $c =~ s{
++ / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
++ | ( "[^"\\]*(?:\\.[^"\\]*)*"
++ | '[^'\\]*(?:\\.[^'\\]*)*' )
++ | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
++ $c =~ s!\s+$!!mg;
++ $c =~ s!^$LF!!mg;
++ $c =~ s!^\s*#\s*!#!mg;
++ $c =~ s!^\s+!!mg;
++
++ open OUT, ">$0" or die "cannot strip $0: $!\n";
++ print OUT "$pl$c\n";
++
++ exit 0;
++}
++
++__DATA__
++*/
++
++#ifndef _P_P_PORTABILITY_H_
++#define _P_P_PORTABILITY_H_
++
++#ifndef DPPP_NAMESPACE
++# define DPPP_NAMESPACE DPPP_
++#endif
++
++#define DPPP_CAT2(x,y) CAT2(x,y)
++#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
++
++#ifndef PERL_REVISION
++# if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
++# define PERL_PATCHLEVEL_H_IMPLICIT
++# include <patchlevel.h>
++# endif
++# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
++# include <could_not_find_Perl_patchlevel.h>
++# endif
++# ifndef PERL_REVISION
++# define PERL_REVISION (5)
++ /* Replace: 1 */
++# define PERL_VERSION PATCHLEVEL
++# define PERL_SUBVERSION SUBVERSION
++ /* Replace PERL_PATCHLEVEL with PERL_VERSION */
++ /* Replace: 0 */
++# endif
++#endif
++
++#define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
++#define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
++
++/* It is very unlikely that anyone will try to use this with Perl 6
++ (or greater), but who knows.
++ */
++#if PERL_REVISION != 5
++# error ppport.h only works with Perl version 5
++#endif /* PERL_REVISION != 5 */
++#ifndef dTHR
++# define dTHR dNOOP
++#endif
++#ifndef dTHX
++# define dTHX dNOOP
++#endif
++
++#ifndef dTHXa
++# define dTHXa(x) dNOOP
++#endif
++#ifndef pTHX
++# define pTHX void
++#endif
++
++#ifndef pTHX_
++# define pTHX_
++#endif
++
++#ifndef aTHX
++# define aTHX
++#endif
++
++#ifndef aTHX_
++# define aTHX_
++#endif
++
++#if (PERL_BCDVERSION < 0x5006000)
++# ifdef USE_THREADS
++# define aTHXR thr
++# define aTHXR_ thr,
++# else
++# define aTHXR
++# define aTHXR_
++# endif
++# define dTHXR dTHR
++#else
++# define aTHXR aTHX
++# define aTHXR_ aTHX_
++# define dTHXR dTHX
++#endif
++#ifndef dTHXoa
++# define dTHXoa(x) dTHXa(x)
++#endif
++
++#ifdef I_LIMITS
++# include <limits.h>
++#endif
++
++#ifndef PERL_UCHAR_MIN
++# define PERL_UCHAR_MIN ((unsigned char)0)
++#endif
++
++#ifndef PERL_UCHAR_MAX
++# ifdef UCHAR_MAX
++# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
++# else
++# ifdef MAXUCHAR
++# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
++# else
++# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
++# endif
++# endif
++#endif
++
++#ifndef PERL_USHORT_MIN
++# define PERL_USHORT_MIN ((unsigned short)0)
++#endif
++
++#ifndef PERL_USHORT_MAX
++# ifdef USHORT_MAX
++# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
++# else
++# ifdef MAXUSHORT
++# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
++# else
++# ifdef USHRT_MAX
++# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
++# else
++# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
++# endif
++# endif
++# endif
++#endif
++
++#ifndef PERL_SHORT_MAX
++# ifdef SHORT_MAX
++# define PERL_SHORT_MAX ((short)SHORT_MAX)
++# else
++# ifdef MAXSHORT /* Often used in <values.h> */
++# define PERL_SHORT_MAX ((short)MAXSHORT)
++# else
++# ifdef SHRT_MAX
++# define PERL_SHORT_MAX ((short)SHRT_MAX)
++# else
++# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
++# endif
++# endif
++# endif
++#endif
++
++#ifndef PERL_SHORT_MIN
++# ifdef SHORT_MIN
++# define PERL_SHORT_MIN ((short)SHORT_MIN)
++# else
++# ifdef MINSHORT
++# define PERL_SHORT_MIN ((short)MINSHORT)
++# else
++# ifdef SHRT_MIN
++# define PERL_SHORT_MIN ((short)SHRT_MIN)
++# else
++# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
++# endif
++# endif
++# endif
++#endif
++
++#ifndef PERL_UINT_MAX
++# ifdef UINT_MAX
++# define PERL_UINT_MAX ((unsigned int)UINT_MAX)
++# else
++# ifdef MAXUINT
++# define PERL_UINT_MAX ((unsigned int)MAXUINT)
++# else
++# define PERL_UINT_MAX (~(unsigned int)0)
++# endif
++# endif
++#endif
++
++#ifndef PERL_UINT_MIN
++# define PERL_UINT_MIN ((unsigned int)0)
++#endif
++
++#ifndef PERL_INT_MAX
++# ifdef INT_MAX
++# define PERL_INT_MAX ((int)INT_MAX)
++# else
++# ifdef MAXINT /* Often used in <values.h> */
++# define PERL_INT_MAX ((int)MAXINT)
++# else
++# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
++# endif
++# endif
++#endif
++
++#ifndef PERL_INT_MIN
++# ifdef INT_MIN
++# define PERL_INT_MIN ((int)INT_MIN)
++# else
++# ifdef MININT
++# define PERL_INT_MIN ((int)MININT)
++# else
++# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
++# endif
++# endif
++#endif
++
++#ifndef PERL_ULONG_MAX
++# ifdef ULONG_MAX
++# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
++# else
++# ifdef MAXULONG
++# define PERL_ULONG_MAX ((unsigned long)MAXULONG)
++# else
++# define PERL_ULONG_MAX (~(unsigned long)0)
++# endif
++# endif
++#endif
++
++#ifndef PERL_ULONG_MIN
++# define PERL_ULONG_MIN ((unsigned long)0L)
++#endif
++
++#ifndef PERL_LONG_MAX
++# ifdef LONG_MAX
++# define PERL_LONG_MAX ((long)LONG_MAX)
++# else
++# ifdef MAXLONG
++# define PERL_LONG_MAX ((long)MAXLONG)
++# else
++# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
++# endif
++# endif
++#endif
++
++#ifndef PERL_LONG_MIN
++# ifdef LONG_MIN
++# define PERL_LONG_MIN ((long)LONG_MIN)
++# else
++# ifdef MINLONG
++# define PERL_LONG_MIN ((long)MINLONG)
++# else
++# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
++# endif
++# endif
++#endif
++
++#if defined(HAS_QUAD) && (defined(convex) || defined(uts))
++# ifndef PERL_UQUAD_MAX
++# ifdef ULONGLONG_MAX
++# define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
++# else
++# ifdef MAXULONGLONG
++# define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
++# else
++# define PERL_UQUAD_MAX (~(unsigned long long)0)
++# endif
++# endif
++# endif
++
++# ifndef PERL_UQUAD_MIN
++# define PERL_UQUAD_MIN ((unsigned long long)0L)
++# endif
++
++# ifndef PERL_QUAD_MAX
++# ifdef LONGLONG_MAX
++# define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
++# else
++# ifdef MAXLONGLONG
++# define PERL_QUAD_MAX ((long long)MAXLONGLONG)
++# else
++# define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
++# endif
++# endif
++# endif
++
++# ifndef PERL_QUAD_MIN
++# ifdef LONGLONG_MIN
++# define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
++# else
++# ifdef MINLONGLONG
++# define PERL_QUAD_MIN ((long long)MINLONGLONG)
++# else
++# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
++# endif
++# endif
++# endif
++#endif
++
++/* This is based on code from 5.003 perl.h */
++#ifdef HAS_QUAD
++# ifdef cray
++#ifndef IVTYPE
++# define IVTYPE int
++#endif
++
++#ifndef IV_MIN
++# define IV_MIN PERL_INT_MIN
++#endif
++
++#ifndef IV_MAX
++# define IV_MAX PERL_INT_MAX
++#endif
++
++#ifndef UV_MIN
++# define UV_MIN PERL_UINT_MIN
++#endif
++
++#ifndef UV_MAX
++# define UV_MAX PERL_UINT_MAX
++#endif
++
++# ifdef INTSIZE
++#ifndef IVSIZE
++# define IVSIZE INTSIZE
++#endif
++
++# endif
++# else
++# if defined(convex) || defined(uts)
++#ifndef IVTYPE
++# define IVTYPE long long
++#endif
++
++#ifndef IV_MIN
++# define IV_MIN PERL_QUAD_MIN
++#endif
++
++#ifndef IV_MAX
++# define IV_MAX PERL_QUAD_MAX
++#endif
++
++#ifndef UV_MIN
++# define UV_MIN PERL_UQUAD_MIN
++#endif
++
++#ifndef UV_MAX
++# define UV_MAX PERL_UQUAD_MAX
++#endif
++
++# ifdef LONGLONGSIZE
++#ifndef IVSIZE
++# define IVSIZE LONGLONGSIZE
++#endif
++
++# endif
++# else
++#ifndef IVTYPE
++# define IVTYPE long
++#endif
++
++#ifndef IV_MIN
++# define IV_MIN PERL_LONG_MIN
++#endif
++
++#ifndef IV_MAX
++# define IV_MAX PERL_LONG_MAX
++#endif
++
++#ifndef UV_MIN
++# define UV_MIN PERL_ULONG_MIN
++#endif
++
++#ifndef UV_MAX
++# define UV_MAX PERL_ULONG_MAX
++#endif
++
++# ifdef LONGSIZE
++#ifndef IVSIZE
++# define IVSIZE LONGSIZE
++#endif
++
++# endif
++# endif
++# endif
++#ifndef IVSIZE
++# define IVSIZE 8
++#endif
++
++#ifndef LONGSIZE
++# define LONGSIZE 8
++#endif
++
++#ifndef PERL_QUAD_MIN
++# define PERL_QUAD_MIN IV_MIN
++#endif
++
++#ifndef PERL_QUAD_MAX
++# define PERL_QUAD_MAX IV_MAX
++#endif
++
++#ifndef PERL_UQUAD_MIN
++# define PERL_UQUAD_MIN UV_MIN
++#endif
++
++#ifndef PERL_UQUAD_MAX
++# define PERL_UQUAD_MAX UV_MAX
++#endif
++
++#else
++#ifndef IVTYPE
++# define IVTYPE long
++#endif
++
++#ifndef LONGSIZE
++# define LONGSIZE 4
++#endif
++
++#ifndef IV_MIN
++# define IV_MIN PERL_LONG_MIN
++#endif
++
++#ifndef IV_MAX
++# define IV_MAX PERL_LONG_MAX
++#endif
++
++#ifndef UV_MIN
++# define UV_MIN PERL_ULONG_MIN
++#endif
++
++#ifndef UV_MAX
++# define UV_MAX PERL_ULONG_MAX
++#endif
++
++#endif
++
++#ifndef IVSIZE
++# ifdef LONGSIZE
++# define IVSIZE LONGSIZE
++# else
++# define IVSIZE 4 /* A bold guess, but the best we can make. */
++# endif
++#endif
++#ifndef UVTYPE
++# define UVTYPE unsigned IVTYPE
++#endif
++
++#ifndef UVSIZE
++# define UVSIZE IVSIZE
++#endif
++#ifndef sv_setuv
++# define sv_setuv(sv, uv) \
++ STMT_START { \
++ UV TeMpUv = uv; \
++ if (TeMpUv <= IV_MAX) \
++ sv_setiv(sv, TeMpUv); \
++ else \
++ sv_setnv(sv, (double)TeMpUv); \
++ } STMT_END
++#endif
++#ifndef newSVuv
++# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
++#endif
++#ifndef sv_2uv
++# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
++#endif
++
++#ifndef SvUVX
++# define SvUVX(sv) ((UV)SvIVX(sv))
++#endif
++
++#ifndef SvUVXx
++# define SvUVXx(sv) SvUVX(sv)
++#endif
++
++#ifndef SvUV
++# define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
++#endif
++
++#ifndef SvUVx
++# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
++#endif
++
++/* Hint: sv_uv
++ * Always use the SvUVx() macro instead of sv_uv().
++ */
++#ifndef sv_uv
++# define sv_uv(sv) SvUVx(sv)
++#endif
++
++#if !defined(SvUOK) && defined(SvIOK_UV)
++# define SvUOK(sv) SvIOK_UV(sv)
++#endif
++#ifndef XST_mUV
++# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
++#endif
++
++#ifndef XSRETURN_UV
++# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
++#endif
++#ifndef PUSHu
++# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
++#endif
++
++#ifndef XPUSHu
++# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
++#endif
++
++#ifdef HAS_MEMCMP
++#ifndef memNE
++# define memNE(s1,s2,l) (memcmp(s1,s2,l))
++#endif
++
++#ifndef memEQ
++# define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
++#endif
++
++#else
++#ifndef memNE
++# define memNE(s1,s2,l) (bcmp(s1,s2,l))
++#endif
++
++#ifndef memEQ
++# define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
++#endif
++
++#endif
++#ifndef memEQs
++# define memEQs(s1, l, s2) \
++ (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
++#endif
++
++#ifndef memNEs
++# define memNEs(s1, l, s2) !memEQs(s1, l, s2)
++#endif
++#ifndef MoveD
++# define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
++#endif
++
++#ifndef CopyD
++# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
++#endif
++
++#ifdef HAS_MEMSET
++#ifndef ZeroD
++# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
++#endif
++
++#else
++#ifndef ZeroD
++# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
++#endif
++
++#endif
++#ifndef PoisonWith
++# define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
++#endif
++
++#ifndef PoisonNew
++# define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
++#endif
++
++#ifndef PoisonFree
++# define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
++#endif
++
++#ifndef Poison
++# define Poison(d,n,t) PoisonFree(d,n,t)
++#endif
++#ifndef Newx
++# define Newx(v,n,t) New(0,v,n,t)
++#endif
++
++#ifndef Newxc
++# define Newxc(v,n,t,c) Newc(0,v,n,t,c)
++#endif
++
++#ifndef Newxz
++# define Newxz(v,n,t) Newz(0,v,n,t)
++#endif
++
++#ifndef PERL_UNUSED_DECL
++# ifdef HASATTRIBUTE
++# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
++# define PERL_UNUSED_DECL
++# else
++# define PERL_UNUSED_DECL __attribute__((unused))
++# endif
++# else
++# define PERL_UNUSED_DECL
++# endif
++#endif
++
++#ifndef PERL_UNUSED_ARG
++# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
++# include <note.h>
++# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
++# else
++# define PERL_UNUSED_ARG(x) ((void)x)
++# endif
++#endif
++
++#ifndef PERL_UNUSED_VAR
++# define PERL_UNUSED_VAR(x) ((void)x)
++#endif
++
++#ifndef PERL_UNUSED_CONTEXT
++# ifdef USE_ITHREADS
++# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
++# else
++# define PERL_UNUSED_CONTEXT
++# endif
++#endif
++#ifndef NOOP
++# define NOOP /*EMPTY*/(void)0
++#endif
++
++#ifndef dNOOP
++# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
++#endif
++
++#ifndef NVTYPE
++# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
++# define NVTYPE long double
++# else
++# define NVTYPE double
++# endif
++typedef NVTYPE NV;
++#endif
++
++#ifndef INT2PTR
++# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
++# define PTRV UV
++# define INT2PTR(any,d) (any)(d)
++# else
++# if PTRSIZE == LONGSIZE
++# define PTRV unsigned long
++# else
++# define PTRV unsigned
++# endif
++# define INT2PTR(any,d) (any)(PTRV)(d)
++# endif
++#endif
++
++#ifndef PTR2ul
++# if PTRSIZE == LONGSIZE
++# define PTR2ul(p) (unsigned long)(p)
++# else
++# define PTR2ul(p) INT2PTR(unsigned long,p)
++# endif
++#endif
++#ifndef PTR2nat
++# define PTR2nat(p) (PTRV)(p)
++#endif
++
++#ifndef NUM2PTR
++# define NUM2PTR(any,d) (any)PTR2nat(d)
++#endif
++
++#ifndef PTR2IV
++# define PTR2IV(p) INT2PTR(IV,p)
++#endif
++
++#ifndef PTR2UV
++# define PTR2UV(p) INT2PTR(UV,p)
++#endif
++
++#ifndef PTR2NV
++# define PTR2NV(p) NUM2PTR(NV,p)
++#endif
++
++#undef START_EXTERN_C
++#undef END_EXTERN_C
++#undef EXTERN_C
++#ifdef __cplusplus
++# define START_EXTERN_C extern "C" {
++# define END_EXTERN_C }
++# define EXTERN_C extern "C"
++#else
++# define START_EXTERN_C
++# define END_EXTERN_C
++# define EXTERN_C extern
++#endif
++
++#if defined(PERL_GCC_PEDANTIC)
++# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
++# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
++# endif
++#endif
++
++#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
++# ifndef PERL_USE_GCC_BRACE_GROUPS
++# define PERL_USE_GCC_BRACE_GROUPS
++# endif
++#endif
++
++#undef STMT_START
++#undef STMT_END
++#ifdef PERL_USE_GCC_BRACE_GROUPS
++# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
++# define STMT_END )
++#else
++# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
++# define STMT_START if (1)
++# define STMT_END else (void)0
++# else
++# define STMT_START do
++# define STMT_END while (0)
++# endif
++#endif
++#ifndef boolSV
++# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
++#endif
++
++/* DEFSV appears first in 5.004_56 */
++#ifndef DEFSV
++# define DEFSV GvSV(PL_defgv)
++#endif
++
++#ifndef SAVE_DEFSV
++# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
++#endif
++
++#ifndef DEFSV_set
++# define DEFSV_set(sv) (DEFSV = (sv))
++#endif
++
++/* Older perls (<=5.003) lack AvFILLp */
++#ifndef AvFILLp
++# define AvFILLp AvFILL
++#endif
++#ifndef ERRSV
++# define ERRSV get_sv("@",FALSE)
++#endif
++
++/* Hint: gv_stashpvn
++ * This function's backport doesn't support the length parameter, but
++ * rather ignores it. Portability can only be ensured if the length
++ * parameter is used for speed reasons, but the length can always be
++ * correctly computed from the string argument.
++ */
++#ifndef gv_stashpvn
++# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
++#endif
++
++/* Replace: 1 */
++#ifndef get_cv
++# define get_cv perl_get_cv
++#endif
++
++#ifndef get_sv
++# define get_sv perl_get_sv
++#endif
++
++#ifndef get_av
++# define get_av perl_get_av
++#endif
++
++#ifndef get_hv
++# define get_hv perl_get_hv
++#endif
++
++/* Replace: 0 */
++#ifndef dUNDERBAR
++# define dUNDERBAR dNOOP
++#endif
++
++#ifndef UNDERBAR
++# define UNDERBAR DEFSV
++#endif
++#ifndef dAX
++# define dAX I32 ax = MARK - PL_stack_base + 1
++#endif
++
++#ifndef dITEMS
++# define dITEMS I32 items = SP - MARK
++#endif
++#ifndef dXSTARG
++# define dXSTARG SV * targ = sv_newmortal()
++#endif
++#ifndef dAXMARK
++# define dAXMARK I32 ax = POPMARK; \
++ register SV ** const mark = PL_stack_base + ax++
++#endif
++#ifndef XSprePUSH
++# define XSprePUSH (sp = PL_stack_base + ax - 1)
++#endif
++
++#if (PERL_BCDVERSION < 0x5005000)
++# undef XSRETURN
++# define XSRETURN(off) \
++ STMT_START { \
++ PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
++ return; \
++ } STMT_END
++#endif
++#ifndef XSPROTO
++# define XSPROTO(name) void name(pTHX_ CV* cv)
++#endif
++
++#ifndef SVfARG
++# define SVfARG(p) ((void*)(p))
++#endif
++#ifndef PERL_ABS
++# define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
++#endif
++#ifndef dVAR
++# define dVAR dNOOP
++#endif
++#ifndef SVf
++# define SVf "_"
++#endif
++#ifndef UTF8_MAXBYTES
++# define UTF8_MAXBYTES UTF8_MAXLEN
++#endif
++#ifndef CPERLscope
++# define CPERLscope(x) x
++#endif
++#ifndef PERL_HASH
++# define PERL_HASH(hash,str,len) \
++ STMT_START { \
++ const char *s_PeRlHaSh = str; \
++ I32 i_PeRlHaSh = len; \
++ U32 hash_PeRlHaSh = 0; \
++ while (i_PeRlHaSh--) \
++ hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
++ (hash) = hash_PeRlHaSh; \
++ } STMT_END
++#endif
++
++#ifndef PERLIO_FUNCS_DECL
++# ifdef PERLIO_FUNCS_CONST
++# define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
++# define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
++# else
++# define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
++# define PERLIO_FUNCS_CAST(funcs) (funcs)
++# endif
++#endif
++
++/* provide these typedefs for older perls */
++#if (PERL_BCDVERSION < 0x5009003)
++
++# ifdef ARGSproto
++typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
++# else
++typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
++# endif
++
++typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
++
++#endif
++#ifndef isPSXSPC
++# define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
++#endif
++
++#ifndef isBLANK
++# define isBLANK(c) ((c) == ' ' || (c) == '\t')
++#endif
++
++#ifdef EBCDIC
++#ifndef isALNUMC
++# define isALNUMC(c) isalnum(c)
++#endif
++
++#ifndef isASCII
++# define isASCII(c) isascii(c)
++#endif
++
++#ifndef isCNTRL
++# define isCNTRL(c) iscntrl(c)
++#endif
++
++#ifndef isGRAPH
++# define isGRAPH(c) isgraph(c)
++#endif
++
++#ifndef isPRINT
++# define isPRINT(c) isprint(c)
++#endif
++
++#ifndef isPUNCT
++# define isPUNCT(c) ispunct(c)
++#endif
++
++#ifndef isXDIGIT
++# define isXDIGIT(c) isxdigit(c)
++#endif
++
++#else
++# if (PERL_BCDVERSION < 0x5010000)
++/* Hint: isPRINT
++ * The implementation in older perl versions includes all of the
++ * isSPACE() characters, which is wrong. The version provided by
++ * Devel::PPPort always overrides a present buggy version.
++ */
++# undef isPRINT
++# endif
++
++#ifdef HAS_QUAD
++# define WIDEST_UTYPE U64TYPE
++#else
++# define WIDEST_UTYPE U32
++#endif
++#ifndef isALNUMC
++# define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
++#endif
++
++#ifndef isASCII
++# define isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
++#endif
++
++#ifndef isCNTRL
++# define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
++#endif
++
++#ifndef isGRAPH
++# define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
++#endif
++
++#ifndef isPRINT
++# define isPRINT(c) (((c) >= 32 && (c) < 127))
++#endif
++
++#ifndef isPUNCT
++# define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
++#endif
++
++#ifndef isXDIGIT
++# define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
++#endif
++
++#endif
++
++#ifndef PERL_SIGNALS_UNSAFE_FLAG
++
++#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
++
++#if (PERL_BCDVERSION < 0x5008000)
++# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
++#else
++# define D_PPP_PERL_SIGNALS_INIT 0
++#endif
++
++#if defined(NEED_PL_signals)
++static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
++#elif defined(NEED_PL_signals_GLOBAL)
++U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
++#else
++extern U32 DPPP_(my_PL_signals);
++#endif
++#define PL_signals DPPP_(my_PL_signals)
++
++#endif
++
++/* Hint: PL_ppaddr
++ * Calling an op via PL_ppaddr requires passing a context argument
++ * for threaded builds. Since the context argument is different for
++ * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
++ * automatically be defined as the correct argument.
++ */
++
++#if (PERL_BCDVERSION <= 0x5005005)
++/* Replace: 1 */
++# define PL_ppaddr ppaddr
++# define PL_no_modify no_modify
++/* Replace: 0 */
++#endif
++
++#if (PERL_BCDVERSION <= 0x5004005)
++/* Replace: 1 */
++# define PL_DBsignal DBsignal
++# define PL_DBsingle DBsingle
++# define PL_DBsub DBsub
++# define PL_DBtrace DBtrace
++# define PL_Sv Sv
++# define PL_bufend bufend
++# define PL_bufptr bufptr
++# define PL_compiling compiling
++# define PL_copline copline
++# define PL_curcop curcop
++# define PL_curstash curstash
++# define PL_debstash debstash
++# define PL_defgv defgv
++# define PL_diehook diehook
++# define PL_dirty dirty
++# define PL_dowarn dowarn
++# define PL_errgv errgv
++# define PL_error_count error_count
++# define PL_expect expect
++# define PL_hexdigit hexdigit
++# define PL_hints hints
++# define PL_in_my in_my
++# define PL_laststatval laststatval
++# define PL_lex_state lex_state
++# define PL_lex_stuff lex_stuff
++# define PL_linestr linestr
++# define PL_na na
++# define PL_perl_destruct_level perl_destruct_level
++# define PL_perldb perldb
++# define PL_rsfp_filters rsfp_filters
++# define PL_rsfp rsfp
++# define PL_stack_base stack_base
++# define PL_stack_sp stack_sp
++# define PL_statcache statcache
++# define PL_stdingv stdingv
++# define PL_sv_arenaroot sv_arenaroot
++# define PL_sv_no sv_no
++# define PL_sv_undef sv_undef
++# define PL_sv_yes sv_yes
++# define PL_tainted tainted
++# define PL_tainting tainting
++# define PL_tokenbuf tokenbuf
++/* Replace: 0 */
++#endif
++
++/* Warning: PL_parser
++ * For perl versions earlier than 5.9.5, this is an always
++ * non-NULL dummy. Also, it cannot be dereferenced. Don't
++ * use it if you can avoid is and unless you absolutely know
++ * what you're doing.
++ * If you always check that PL_parser is non-NULL, you can
++ * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
++ * a dummy parser structure.
++ */
++
++#if (PERL_BCDVERSION >= 0x5009005)
++# ifdef DPPP_PL_parser_NO_DUMMY
++# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
++ (croak("panic: PL_parser == NULL in %s:%d", \
++ __FILE__, __LINE__), (yy_parser *) NULL))->var)
++# else
++# ifdef DPPP_PL_parser_NO_DUMMY_WARNING
++# define D_PPP_parser_dummy_warning(var)
++# else
++# define D_PPP_parser_dummy_warning(var) \
++ warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
++# endif
++# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
++ (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
++#if defined(NEED_PL_parser)
++static yy_parser DPPP_(dummy_PL_parser);
++#elif defined(NEED_PL_parser_GLOBAL)
++yy_parser DPPP_(dummy_PL_parser);
++#else
++extern yy_parser DPPP_(dummy_PL_parser);
++#endif
++
++# endif
++
++/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
++/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
++ * Do not use this variable unless you know exactly what you're
++ * doint. It is internal to the perl parser and may change or even
++ * be removed in the future. As of perl 5.9.5, you have to check
++ * for (PL_parser != NULL) for this variable to have any effect.
++ * An always non-NULL PL_parser dummy is provided for earlier
++ * perl versions.
++ * If PL_parser is NULL when you try to access this variable, a
++ * dummy is being accessed instead and a warning is issued unless
++ * you define DPPP_PL_parser_NO_DUMMY_WARNING.
++ * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
++ * this variable will croak with a panic message.
++ */
++
++# define PL_expect D_PPP_my_PL_parser_var(expect)
++# define PL_copline D_PPP_my_PL_parser_var(copline)
++# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
++# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
++# define PL_linestr D_PPP_my_PL_parser_var(linestr)
++# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
++# define PL_bufend D_PPP_my_PL_parser_var(bufend)
++# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
++# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
++# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
++# define PL_in_my D_PPP_my_PL_parser_var(in_my)
++# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
++# define PL_error_count D_PPP_my_PL_parser_var(error_count)
++
++
++#else
++
++/* ensure that PL_parser != NULL and cannot be dereferenced */
++# define PL_parser ((void *) 1)
++
++#endif
++#ifndef mPUSHs
++# define mPUSHs(s) PUSHs(sv_2mortal(s))
++#endif
++
++#ifndef PUSHmortal
++# define PUSHmortal PUSHs(sv_newmortal())
++#endif
++
++#ifndef mPUSHp
++# define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
++#endif
++
++#ifndef mPUSHn
++# define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
++#endif
++
++#ifndef mPUSHi
++# define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
++#endif
++
++#ifndef mPUSHu
++# define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
++#endif
++#ifndef mXPUSHs
++# define mXPUSHs(s) XPUSHs(sv_2mortal(s))
++#endif
++
++#ifndef XPUSHmortal
++# define XPUSHmortal XPUSHs(sv_newmortal())
++#endif
++
++#ifndef mXPUSHp
++# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
++#endif
++
++#ifndef mXPUSHn
++# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
++#endif
++
++#ifndef mXPUSHi
++# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
++#endif
++
++#ifndef mXPUSHu
++# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
++#endif
++
++/* Replace: 1 */
++#ifndef call_sv
++# define call_sv perl_call_sv
++#endif
++
++#ifndef call_pv
++# define call_pv perl_call_pv
++#endif
++
++#ifndef call_argv
++# define call_argv perl_call_argv
++#endif
++
++#ifndef call_method
++# define call_method perl_call_method
++#endif
++#ifndef eval_sv
++# define eval_sv perl_eval_sv
++#endif
++
++/* Replace: 0 */
++#ifndef PERL_LOADMOD_DENY
++# define PERL_LOADMOD_DENY 0x1
++#endif
++
++#ifndef PERL_LOADMOD_NOIMPORT
++# define PERL_LOADMOD_NOIMPORT 0x2
++#endif
++
++#ifndef PERL_LOADMOD_IMPORT_OPS
++# define PERL_LOADMOD_IMPORT_OPS 0x4
++#endif
++
++#ifndef G_METHOD
++# define G_METHOD 64
++# ifdef call_sv
++# undef call_sv
++# endif
++# if (PERL_BCDVERSION < 0x5006000)
++# define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
++ (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
++# else
++# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
++ (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
++# endif
++#endif
++
++/* Replace perl_eval_pv with eval_pv */
++
++#ifndef eval_pv
++#if defined(NEED_eval_pv)
++static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
++static
++#else
++extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
++#endif
++
++#ifdef eval_pv
++# undef eval_pv
++#endif
++#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
++#define Perl_eval_pv DPPP_(my_eval_pv)
++
++#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
++
++SV*
++DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
++{
++ dSP;
++ SV* sv = newSVpv(p, 0);
++
++ PUSHMARK(sp);
++ eval_sv(sv, G_SCALAR);
++ SvREFCNT_dec(sv);
++
++ SPAGAIN;
++ sv = POPs;
++ PUTBACK;
++
++ if (croak_on_error && SvTRUE(GvSV(errgv)))
++ croak(SvPVx(GvSV(errgv), na));
++
++ return sv;
++}
++
++#endif
++#endif
++
++#ifndef vload_module
++#if defined(NEED_vload_module)
++static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
++static
++#else
++extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
++#endif
++
++#ifdef vload_module
++# undef vload_module
++#endif
++#define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
++#define Perl_vload_module DPPP_(my_vload_module)
++
++#if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
++
++void
++DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
++{
++ dTHR;
++ dVAR;
++ OP *veop, *imop;
++
++ OP * const modname = newSVOP(OP_CONST, 0, name);
++ /* 5.005 has a somewhat hacky force_normal that doesn't croak on
++ SvREADONLY() if PL_compling is true. Current perls take care in
++ ck_require() to correctly turn off SvREADONLY before calling
++ force_normal_flags(). This seems a better fix than fudging PL_compling
++ */
++ SvREADONLY_off(((SVOP*)modname)->op_sv);
++ modname->op_private |= OPpCONST_BARE;
++ if (ver) {
++ veop = newSVOP(OP_CONST, 0, ver);
++ }
++ else
++ veop = NULL;
++ if (flags & PERL_LOADMOD_NOIMPORT) {
++ imop = sawparens(newNULLLIST());
++ }
++ else if (flags & PERL_LOADMOD_IMPORT_OPS) {
++ imop = va_arg(*args, OP*);
++ }
++ else {
++ SV *sv;
++ imop = NULL;
++ sv = va_arg(*args, SV*);
++ while (sv) {
++ imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
++ sv = va_arg(*args, SV*);
++ }
++ }
++ {
++ const line_t ocopline = PL_copline;
++ COP * const ocurcop = PL_curcop;
++ const int oexpect = PL_expect;
++
++#if (PERL_BCDVERSION >= 0x5004000)
++ utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
++ veop, modname, imop);
++#else
++ utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
++ modname, imop);
++#endif
++ PL_expect = oexpect;
++ PL_copline = ocopline;
++ PL_curcop = ocurcop;
++ }
++}
++
++#endif
++#endif
++
++#ifndef load_module
++#if defined(NEED_load_module)
++static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
++static
++#else
++extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
++#endif
++
++#ifdef load_module
++# undef load_module
++#endif
++#define load_module DPPP_(my_load_module)
++#define Perl_load_module DPPP_(my_load_module)
++
++#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
++
++void
++DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
++{
++ va_list args;
++ va_start(args, ver);
++ vload_module(flags, name, ver, &args);
++ va_end(args);
++}
++
++#endif
++#endif
++#ifndef newRV_inc
++# define newRV_inc(sv) newRV(sv) /* Replace */
++#endif
++
++#ifndef newRV_noinc
++#if defined(NEED_newRV_noinc)
++static SV * DPPP_(my_newRV_noinc)(SV *sv);
++static
++#else
++extern SV * DPPP_(my_newRV_noinc)(SV *sv);
++#endif
++
++#ifdef newRV_noinc
++# undef newRV_noinc
++#endif
++#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
++#define Perl_newRV_noinc DPPP_(my_newRV_noinc)
++
++#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
++SV *
++DPPP_(my_newRV_noinc)(SV *sv)
++{
++ SV *rv = (SV *)newRV(sv);
++ SvREFCNT_dec(sv);
++ return rv;
++}
++#endif
++#endif
++
++/* Hint: newCONSTSUB
++ * Returns a CV* as of perl-5.7.1. This return value is not supported
++ * by Devel::PPPort.
++ */
++
++/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
++#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
++#if defined(NEED_newCONSTSUB)
++static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
++static
++#else
++extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
++#endif
++
++#ifdef newCONSTSUB
++# undef newCONSTSUB
++#endif
++#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
++#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
++
++#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
++
++/* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
++/* (There's no PL_parser in perl < 5.005, so this is completely safe) */
++#define D_PPP_PL_copline PL_copline
++
++void
++DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
++{
++ U32 oldhints = PL_hints;
++ HV *old_cop_stash = PL_curcop->cop_stash;
++ HV *old_curstash = PL_curstash;
++ line_t oldline = PL_curcop->cop_line;
++ PL_curcop->cop_line = D_PPP_PL_copline;
++
++ PL_hints &= ~HINT_BLOCK_SCOPE;
++ if (stash)
++ PL_curstash = PL_curcop->cop_stash = stash;
++
++ newSUB(
++
++#if (PERL_BCDVERSION < 0x5003022)
++ start_subparse(),
++#elif (PERL_BCDVERSION == 0x5003022)
++ start_subparse(0),
++#else /* 5.003_23 onwards */
++ start_subparse(FALSE, 0),
++#endif
++
++ newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
++ newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
++ newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
++ );
++
++ PL_hints = oldhints;
++ PL_curcop->cop_stash = old_cop_stash;
++ PL_curstash = old_curstash;
++ PL_curcop->cop_line = oldline;
++}
++#endif
++#endif
++
++/*
++ * Boilerplate macros for initializing and accessing interpreter-local
++ * data from C. All statics in extensions should be reworked to use
++ * this, if you want to make the extension thread-safe. See ext/re/re.xs
++ * for an example of the use of these macros.
++ *
++ * Code that uses these macros is responsible for the following:
++ * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
++ * 2. Declare a typedef named my_cxt_t that is a structure that contains
++ * all the data that needs to be interpreter-local.
++ * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
++ * 4. Use the MY_CXT_INIT macro such that it is called exactly once
++ * (typically put in the BOOT: section).
++ * 5. Use the members of the my_cxt_t structure everywhere as
++ * MY_CXT.member.
++ * 6. Use the dMY_CXT macro (a declaration) in all the functions that
++ * access MY_CXT.
++ */
++
++#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
++ defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
++
++#ifndef START_MY_CXT
++
++/* This must appear in all extensions that define a my_cxt_t structure,
++ * right after the definition (i.e. at file scope). The non-threads
++ * case below uses it to declare the data as static. */
++#define START_MY_CXT
++
++#if (PERL_BCDVERSION < 0x5004068)
++/* Fetches the SV that keeps the per-interpreter data. */
++#define dMY_CXT_SV \
++ SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
++#else /* >= perl5.004_68 */
++#define dMY_CXT_SV \
++ SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
++ sizeof(MY_CXT_KEY)-1, TRUE)
++#endif /* < perl5.004_68 */
++
++/* This declaration should be used within all functions that use the
++ * interpreter-local data. */
++#define dMY_CXT \
++ dMY_CXT_SV; \
++ my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
++
++/* Creates and zeroes the per-interpreter data.
++ * (We allocate my_cxtp in a Perl SV so that it will be released when
++ * the interpreter goes away.) */
++#define MY_CXT_INIT \
++ dMY_CXT_SV; \
++ /* newSV() allocates one more than needed */ \
++ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
++ Zero(my_cxtp, 1, my_cxt_t); \
++ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
++
++/* This macro must be used to access members of the my_cxt_t structure.
++ * e.g. MYCXT.some_data */
++#define MY_CXT (*my_cxtp)
++
++/* Judicious use of these macros can reduce the number of times dMY_CXT
++ * is used. Use is similar to pTHX, aTHX etc. */
++#define pMY_CXT my_cxt_t *my_cxtp
++#define pMY_CXT_ pMY_CXT,
++#define _pMY_CXT ,pMY_CXT
++#define aMY_CXT my_cxtp
++#define aMY_CXT_ aMY_CXT,
++#define _aMY_CXT ,aMY_CXT
++
++#endif /* START_MY_CXT */
++
++#ifndef MY_CXT_CLONE
++/* Clones the per-interpreter data. */
++#define MY_CXT_CLONE \
++ dMY_CXT_SV; \
++ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
++ Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
++ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
++#endif
++
++#else /* single interpreter */
++
++#ifndef START_MY_CXT
++
++#define START_MY_CXT static my_cxt_t my_cxt;
++#define dMY_CXT_SV dNOOP
++#define dMY_CXT dNOOP
++#define MY_CXT_INIT NOOP
++#define MY_CXT my_cxt
++
++#define pMY_CXT void
++#define pMY_CXT_
++#define _pMY_CXT
++#define aMY_CXT
++#define aMY_CXT_
++#define _aMY_CXT
++
++#endif /* START_MY_CXT */
++
++#ifndef MY_CXT_CLONE
++#define MY_CXT_CLONE NOOP
++#endif
++
++#endif
++
++#ifndef IVdf
++# if IVSIZE == LONGSIZE
++# define IVdf "ld"
++# define UVuf "lu"
++# define UVof "lo"
++# define UVxf "lx"
++# define UVXf "lX"
++# elif IVSIZE == INTSIZE
++# define IVdf "d"
++# define UVuf "u"
++# define UVof "o"
++# define UVxf "x"
++# define UVXf "X"
++# else
++# error "cannot define IV/UV formats"
++# endif
++#endif
++
++#ifndef NVef
++# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
++ defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
++ /* Not very likely, but let's try anyway. */
++# define NVef PERL_PRIeldbl
++# define NVff PERL_PRIfldbl
++# define NVgf PERL_PRIgldbl
++# else
++# define NVef "e"
++# define NVff "f"
++# define NVgf "g"
++# endif
++#endif
++
++#ifndef SvREFCNT_inc
++# ifdef PERL_USE_GCC_BRACE_GROUPS
++# define SvREFCNT_inc(sv) \
++ ({ \
++ SV * const _sv = (SV*)(sv); \
++ if (_sv) \
++ (SvREFCNT(_sv))++; \
++ _sv; \
++ })
++# else
++# define SvREFCNT_inc(sv) \
++ ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
++# endif
++#endif
++
++#ifndef SvREFCNT_inc_simple
++# ifdef PERL_USE_GCC_BRACE_GROUPS
++# define SvREFCNT_inc_simple(sv) \
++ ({ \
++ if (sv) \
++ (SvREFCNT(sv))++; \
++ (SV *)(sv); \
++ })
++# else
++# define SvREFCNT_inc_simple(sv) \
++ ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
++# endif
++#endif
++
++#ifndef SvREFCNT_inc_NN
++# ifdef PERL_USE_GCC_BRACE_GROUPS
++# define SvREFCNT_inc_NN(sv) \
++ ({ \
++ SV * const _sv = (SV*)(sv); \
++ SvREFCNT(_sv)++; \
++ _sv; \
++ })
++# else
++# define SvREFCNT_inc_NN(sv) \
++ (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
++# endif
++#endif
++
++#ifndef SvREFCNT_inc_void
++# ifdef PERL_USE_GCC_BRACE_GROUPS
++# define SvREFCNT_inc_void(sv) \
++ ({ \
++ SV * const _sv = (SV*)(sv); \
++ if (_sv) \
++ (void)(SvREFCNT(_sv)++); \
++ })
++# else
++# define SvREFCNT_inc_void(sv) \
++ (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
++# endif
++#endif
++#ifndef SvREFCNT_inc_simple_void
++# define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
++#endif
++
++#ifndef SvREFCNT_inc_simple_NN
++# define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
++#endif
++
++#ifndef SvREFCNT_inc_void_NN
++# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
++#endif
++
++#ifndef SvREFCNT_inc_simple_void_NN
++# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
++#endif
++
++#ifndef newSV_type
++
++#if defined(NEED_newSV_type)
++static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
++static
++#else
++extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
++#endif
++
++#ifdef newSV_type
++# undef newSV_type
++#endif
++#define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
++#define Perl_newSV_type DPPP_(my_newSV_type)
++
++#if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
++
++SV*
++DPPP_(my_newSV_type)(pTHX_ svtype const t)
++{
++ SV* const sv = newSV(0);
++ sv_upgrade(sv, t);
++ return sv;
++}
++
++#endif
++
++#endif
++
++#if (PERL_BCDVERSION < 0x5006000)
++# define D_PPP_CONSTPV_ARG(x) ((char *) (x))
++#else
++# define D_PPP_CONSTPV_ARG(x) (x)
++#endif
++#ifndef newSVpvn
++# define newSVpvn(data,len) ((data) \
++ ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
++ : newSV(0))
++#endif
++#ifndef newSVpvn_utf8
++# define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
++#endif
++#ifndef SVf_UTF8
++# define SVf_UTF8 0
++#endif
++
++#ifndef newSVpvn_flags
++
++#if defined(NEED_newSVpvn_flags)
++static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
++static
++#else
++extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
++#endif
++
++#ifdef newSVpvn_flags
++# undef newSVpvn_flags
++#endif
++#define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
++#define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
++
++#if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
++
++SV *
++DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
++{
++ SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
++ SvFLAGS(sv) |= (flags & SVf_UTF8);
++ return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
++}
++
++#endif
++
++#endif
++
++/* Backwards compatibility stuff... :-( */
++#if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
++# define NEED_sv_2pv_flags
++#endif
++#if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
++# define NEED_sv_2pv_flags_GLOBAL
++#endif
++
++/* Hint: sv_2pv_nolen
++ * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
++ */
++#ifndef sv_2pv_nolen
++# define sv_2pv_nolen(sv) SvPV_nolen(sv)
++#endif
++
++#ifdef SvPVbyte
++
++/* Hint: SvPVbyte
++ * Does not work in perl-5.6.1, ppport.h implements a version
++ * borrowed from perl-5.7.3.
++ */
++
++#if (PERL_BCDVERSION < 0x5007000)
++
++#if defined(NEED_sv_2pvbyte)
++static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
++static
++#else
++extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
++#endif
++
++#ifdef sv_2pvbyte
++# undef sv_2pvbyte
++#endif
++#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
++#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
++
++#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
++
++char *
++DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
++{
++ sv_utf8_downgrade(sv,0);
++ return SvPV(sv,*lp);
++}
++
++#endif
++
++/* Hint: sv_2pvbyte
++ * Use the SvPVbyte() macro instead of sv_2pvbyte().
++ */
++
++#undef SvPVbyte
++
++#define SvPVbyte(sv, lp) \
++ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
++ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
++
++#endif
++
++#else
++
++# define SvPVbyte SvPV
++# define sv_2pvbyte sv_2pv
++
++#endif
++#ifndef sv_2pvbyte_nolen
++# define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
++#endif
++
++/* Hint: sv_pvn
++ * Always use the SvPV() macro instead of sv_pvn().
++ */
++
++/* Hint: sv_pvn_force
++ * Always use the SvPV_force() macro instead of sv_pvn_force().
++ */
++
++/* If these are undefined, they're not handled by the core anyway */
++#ifndef SV_IMMEDIATE_UNREF
++# define SV_IMMEDIATE_UNREF 0
++#endif
++
++#ifndef SV_GMAGIC
++# define SV_GMAGIC 0
++#endif
++
++#ifndef SV_COW_DROP_PV
++# define SV_COW_DROP_PV 0
++#endif
++
++#ifndef SV_UTF8_NO_ENCODING
++# define SV_UTF8_NO_ENCODING 0
++#endif
++
++#ifndef SV_NOSTEAL
++# define SV_NOSTEAL 0
++#endif
++
++#ifndef SV_CONST_RETURN
++# define SV_CONST_RETURN 0
++#endif
++
++#ifndef SV_MUTABLE_RETURN
++# define SV_MUTABLE_RETURN 0
++#endif
++
++#ifndef SV_SMAGIC
++# define SV_SMAGIC 0
++#endif
++
++#ifndef SV_HAS_TRAILING_NUL
++# define SV_HAS_TRAILING_NUL 0
++#endif
++
++#ifndef SV_COW_SHARED_HASH_KEYS
++# define SV_COW_SHARED_HASH_KEYS 0
++#endif
++
++#if (PERL_BCDVERSION < 0x5007002)
++
++#if defined(NEED_sv_2pv_flags)
++static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
++static
++#else
++extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
++#endif
++
++#ifdef sv_2pv_flags
++# undef sv_2pv_flags
++#endif
++#define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
++#define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
++
++#if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
++
++char *
++DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
++{
++ STRLEN n_a = (STRLEN) flags;
++ return sv_2pv(sv, lp ? lp : &n_a);
++}
++
++#endif
++
++#if defined(NEED_sv_pvn_force_flags)
++static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
++static
++#else
++extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
++#endif
++
++#ifdef sv_pvn_force_flags
++# undef sv_pvn_force_flags
++#endif
++#define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
++#define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
++
++#if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
++
++char *
++DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
++{
++ STRLEN n_a = (STRLEN) flags;
++ return sv_pvn_force(sv, lp ? lp : &n_a);
++}
++
++#endif
++
++#endif
++
++#if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
++# define DPPP_SVPV_NOLEN_LP_ARG &PL_na
++#else
++# define DPPP_SVPV_NOLEN_LP_ARG 0
++#endif
++#ifndef SvPV_const
++# define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
++#endif
++
++#ifndef SvPV_mutable
++# define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
++#endif
++#ifndef SvPV_flags
++# define SvPV_flags(sv, lp, flags) \
++ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
++ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
++#endif
++#ifndef SvPV_flags_const
++# define SvPV_flags_const(sv, lp, flags) \
++ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
++ ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
++ (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
++#endif
++#ifndef SvPV_flags_const_nolen
++# define SvPV_flags_const_nolen(sv, flags) \
++ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
++ ? SvPVX_const(sv) : \
++ (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
++#endif
++#ifndef SvPV_flags_mutable
++# define SvPV_flags_mutable(sv, lp, flags) \
++ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
++ ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
++ sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
++#endif
++#ifndef SvPV_force
++# define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
++#endif
++
++#ifndef SvPV_force_nolen
++# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
++#endif
++
++#ifndef SvPV_force_mutable
++# define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
++#endif
++
++#ifndef SvPV_force_nomg
++# define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
++#endif
++
++#ifndef SvPV_force_nomg_nolen
++# define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
++#endif
++#ifndef SvPV_force_flags
++# define SvPV_force_flags(sv, lp, flags) \
++ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
++ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
++#endif
++#ifndef SvPV_force_flags_nolen
++# define SvPV_force_flags_nolen(sv, flags) \
++ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
++ ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
++#endif
++#ifndef SvPV_force_flags_mutable
++# define SvPV_force_flags_mutable(sv, lp, flags) \
++ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
++ ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
++ : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
++#endif
++#ifndef SvPV_nolen
++# define SvPV_nolen(sv) \
++ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
++ ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
++#endif
++#ifndef SvPV_nolen_const
++# define SvPV_nolen_const(sv) \
++ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
++ ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
++#endif
++#ifndef SvPV_nomg
++# define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
++#endif
++
++#ifndef SvPV_nomg_const
++# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
++#endif
++
++#ifndef SvPV_nomg_const_nolen
++# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
++#endif
++
++#ifndef SvPV_nomg_nolen
++# define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
++ ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, 0))
++#endif
++#ifndef SvPV_renew
++# define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
++ SvPV_set((sv), (char *) saferealloc( \
++ (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
++ } STMT_END
++#endif
++#ifndef SvMAGIC_set
++# define SvMAGIC_set(sv, val) \
++ STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
++ (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
++#endif
++
++#if (PERL_BCDVERSION < 0x5009003)
++#ifndef SvPVX_const
++# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
++#endif
++
++#ifndef SvPVX_mutable
++# define SvPVX_mutable(sv) (0 + SvPVX(sv))
++#endif
++#ifndef SvRV_set
++# define SvRV_set(sv, val) \
++ STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
++ (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
++#endif
++
++#else
++#ifndef SvPVX_const
++# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
++#endif
++
++#ifndef SvPVX_mutable
++# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
++#endif
++#ifndef SvRV_set
++# define SvRV_set(sv, val) \
++ STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
++ ((sv)->sv_u.svu_rv = (val)); } STMT_END
++#endif
++
++#endif
++#ifndef SvSTASH_set
++# define SvSTASH_set(sv, val) \
++ STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
++ (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
++#endif
++
++#if (PERL_BCDVERSION < 0x5004000)
++#ifndef SvUV_set
++# define SvUV_set(sv, val) \
++ STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
++ (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
++#endif
++
++#else
++#ifndef SvUV_set
++# define SvUV_set(sv, val) \
++ STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
++ (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
++#endif
++
++#endif
++
++#if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
++#if defined(NEED_vnewSVpvf)
++static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
++static
++#else
++extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
++#endif
++
++#ifdef vnewSVpvf
++# undef vnewSVpvf
++#endif
++#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
++#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
++
++#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
++
++SV *
++DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
++{
++ register SV *sv = newSV(0);
++ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
++ return sv;
++}
++
++#endif
++#endif
++
++#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
++# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
++#endif
++
++#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
++# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
++#endif
++
++#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
++#if defined(NEED_sv_catpvf_mg)
++static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
++static
++#else
++extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
++#endif
++
++#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
++
++#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
++
++void
++DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
++{
++ va_list args;
++ va_start(args, pat);
++ sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
++ SvSETMAGIC(sv);
++ va_end(args);
++}
++
++#endif
++#endif
++
++#ifdef PERL_IMPLICIT_CONTEXT
++#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
++#if defined(NEED_sv_catpvf_mg_nocontext)
++static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
++static
++#else
++extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
++#endif
++
++#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
++#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
++
++#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
++
++void
++DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
++{
++ dTHX;
++ va_list args;
++ va_start(args, pat);
++ sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
++ SvSETMAGIC(sv);
++ va_end(args);
++}
++
++#endif
++#endif
++#endif
++
++/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
++#ifndef sv_catpvf_mg
++# ifdef PERL_IMPLICIT_CONTEXT
++# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
++# else
++# define sv_catpvf_mg Perl_sv_catpvf_mg
++# endif
++#endif
++
++#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
++# define sv_vcatpvf_mg(sv, pat, args) \
++ STMT_START { \
++ sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
++ SvSETMAGIC(sv); \
++ } STMT_END
++#endif
++
++#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
++#if defined(NEED_sv_setpvf_mg)
++static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
++static
++#else
++extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
++#endif
++
++#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
++
++#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
++
++void
++DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
++{
++ va_list args;
++ va_start(args, pat);
++ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
++ SvSETMAGIC(sv);
++ va_end(args);
++}
++
++#endif
++#endif
++
++#ifdef PERL_IMPLICIT_CONTEXT
++#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
++#if defined(NEED_sv_setpvf_mg_nocontext)
++static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
++static
++#else
++extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
++#endif
++
++#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
++#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
++
++#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
++
++void
++DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
++{
++ dTHX;
++ va_list args;
++ va_start(args, pat);
++ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
++ SvSETMAGIC(sv);
++ va_end(args);
++}
++
++#endif
++#endif
++#endif
++
++/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
++#ifndef sv_setpvf_mg
++# ifdef PERL_IMPLICIT_CONTEXT
++# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
++# else
++# define sv_setpvf_mg Perl_sv_setpvf_mg
++# endif
++#endif
++
++#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
++# define sv_vsetpvf_mg(sv, pat, args) \
++ STMT_START { \
++ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
++ SvSETMAGIC(sv); \
++ } STMT_END
++#endif
++
++/* Hint: newSVpvn_share
++ * The SVs created by this function only mimic the behaviour of
++ * shared PVs without really being shared. Only use if you know
++ * what you're doing.
++ */
++
++#ifndef newSVpvn_share
++
++#if defined(NEED_newSVpvn_share)
++static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
++static
++#else
++extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
++#endif
++
++#ifdef newSVpvn_share
++# undef newSVpvn_share
++#endif
++#define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
++#define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
++
++#if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
++
++SV *
++DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
++{
++ SV *sv;
++ if (len < 0)
++ len = -len;
++ if (!hash)
++ PERL_HASH(hash, (char*) src, len);
++ sv = newSVpvn((char *) src, len);
++ sv_upgrade(sv, SVt_PVIV);
++ SvIVX(sv) = hash;
++ SvREADONLY_on(sv);
++ SvPOK_on(sv);
++ return sv;
++}
++
++#endif
++
++#endif
++#ifndef SvSHARED_HASH
++# define SvSHARED_HASH(sv) (0 + SvUVX(sv))
++#endif
++#ifndef HvNAME_get
++# define HvNAME_get(hv) HvNAME(hv)
++#endif
++#ifndef HvNAMELEN_get
++# define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
++#endif
++#ifndef GvSVn
++# define GvSVn(gv) GvSV(gv)
++#endif
++
++#ifndef isGV_with_GP
++# define isGV_with_GP(gv) isGV(gv)
++#endif
++
++#ifndef gv_fetchpvn_flags
++# define gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt)
++#endif
++
++#ifndef gv_fetchsv
++# define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
++#endif
++#ifndef get_cvn_flags
++# define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
++#endif
++#ifndef WARN_ALL
++# define WARN_ALL 0
++#endif
++
++#ifndef WARN_CLOSURE
++# define WARN_CLOSURE 1
++#endif
++
++#ifndef WARN_DEPRECATED
++# define WARN_DEPRECATED 2
++#endif
++
++#ifndef WARN_EXITING
++# define WARN_EXITING 3
++#endif
++
++#ifndef WARN_GLOB
++# define WARN_GLOB 4
++#endif
++
++#ifndef WARN_IO
++# define WARN_IO 5
++#endif
++
++#ifndef WARN_CLOSED
++# define WARN_CLOSED 6
++#endif
++
++#ifndef WARN_EXEC
++# define WARN_EXEC 7
++#endif
++
++#ifndef WARN_LAYER
++# define WARN_LAYER 8
++#endif
++
++#ifndef WARN_NEWLINE
++# define WARN_NEWLINE 9
++#endif
++
++#ifndef WARN_PIPE
++# define WARN_PIPE 10
++#endif
++
++#ifndef WARN_UNOPENED
++# define WARN_UNOPENED 11
++#endif
++
++#ifndef WARN_MISC
++# define WARN_MISC 12
++#endif
++
++#ifndef WARN_NUMERIC
++# define WARN_NUMERIC 13
++#endif
++
++#ifndef WARN_ONCE
++# define WARN_ONCE 14
++#endif
++
++#ifndef WARN_OVERFLOW
++# define WARN_OVERFLOW 15
++#endif
++
++#ifndef WARN_PACK
++# define WARN_PACK 16
++#endif
++
++#ifndef WARN_PORTABLE
++# define WARN_PORTABLE 17
++#endif
++
++#ifndef WARN_RECURSION
++# define WARN_RECURSION 18
++#endif
++
++#ifndef WARN_REDEFINE
++# define WARN_REDEFINE 19
++#endif
++
++#ifndef WARN_REGEXP
++# define WARN_REGEXP 20
++#endif
++
++#ifndef WARN_SEVERE
++# define WARN_SEVERE 21
++#endif
++
++#ifndef WARN_DEBUGGING
++# define WARN_DEBUGGING 22
++#endif
++
++#ifndef WARN_INPLACE
++# define WARN_INPLACE 23
++#endif
++
++#ifndef WARN_INTERNAL
++# define WARN_INTERNAL 24
++#endif
++
++#ifndef WARN_MALLOC
++# define WARN_MALLOC 25
++#endif
++
++#ifndef WARN_SIGNAL
++# define WARN_SIGNAL 26
++#endif
++
++#ifndef WARN_SUBSTR
++# define WARN_SUBSTR 27
++#endif
++
++#ifndef WARN_SYNTAX
++# define WARN_SYNTAX 28
++#endif
++
++#ifndef WARN_AMBIGUOUS
++# define WARN_AMBIGUOUS 29
++#endif
++
++#ifndef WARN_BAREWORD
++# define WARN_BAREWORD 30
++#endif
++
++#ifndef WARN_DIGIT
++# define WARN_DIGIT 31
++#endif
++
++#ifndef WARN_PARENTHESIS
++# define WARN_PARENTHESIS 32
++#endif
++
++#ifndef WARN_PRECEDENCE
++# define WARN_PRECEDENCE 33
++#endif
++
++#ifndef WARN_PRINTF
++# define WARN_PRINTF 34
++#endif
++
++#ifndef WARN_PROTOTYPE
++# define WARN_PROTOTYPE 35
++#endif
++
++#ifndef WARN_QW
++# define WARN_QW 36
++#endif
++
++#ifndef WARN_RESERVED
++# define WARN_RESERVED 37
++#endif
++
++#ifndef WARN_SEMICOLON
++# define WARN_SEMICOLON 38
++#endif
++
++#ifndef WARN_TAINT
++# define WARN_TAINT 39
++#endif
++
++#ifndef WARN_THREADS
++# define WARN_THREADS 40
++#endif
++
++#ifndef WARN_UNINITIALIZED
++# define WARN_UNINITIALIZED 41
++#endif
++
++#ifndef WARN_UNPACK
++# define WARN_UNPACK 42
++#endif
++
++#ifndef WARN_UNTIE
++# define WARN_UNTIE 43
++#endif
++
++#ifndef WARN_UTF8
++# define WARN_UTF8 44
++#endif
++
++#ifndef WARN_VOID
++# define WARN_VOID 45
++#endif
++
++#ifndef WARN_ASSERTIONS
++# define WARN_ASSERTIONS 46
++#endif
++#ifndef packWARN
++# define packWARN(a) (a)
++#endif
++
++#ifndef ckWARN
++# ifdef G_WARN_ON
++# define ckWARN(a) (PL_dowarn & G_WARN_ON)
++# else
++# define ckWARN(a) PL_dowarn
++# endif
++#endif
++
++#if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
++#if defined(NEED_warner)
++static void DPPP_(my_warner)(U32 err, const char *pat, ...);
++static
++#else
++extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
++#endif
++
++#define Perl_warner DPPP_(my_warner)
++
++#if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
++
++void
++DPPP_(my_warner)(U32 err, const char *pat, ...)
++{
++ SV *sv;
++ va_list args;
++
++ PERL_UNUSED_ARG(err);
++
++ va_start(args, pat);
++ sv = vnewSVpvf(pat, &args);
++ va_end(args);
++ sv_2mortal(sv);
++ warn("%s", SvPV_nolen(sv));
++}
++
++#define warner Perl_warner
++
++#define Perl_warner_nocontext Perl_warner
++
++#endif
++#endif
++
++/* concatenating with "" ensures that only literal strings are accepted as argument
++ * note that STR_WITH_LEN() can't be used as argument to macros or functions that
++ * under some configurations might be macros
++ */
++#ifndef STR_WITH_LEN
++# define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
++#endif
++#ifndef newSVpvs
++# define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
++#endif
++
++#ifndef newSVpvs_flags
++# define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
++#endif
++
++#ifndef newSVpvs_share
++# define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
++#endif
++
++#ifndef sv_catpvs
++# define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
++#endif
++
++#ifndef sv_setpvs
++# define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
++#endif
++
++#ifndef hv_fetchs
++# define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
++#endif
++
++#ifndef hv_stores
++# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
++#endif
++#ifndef gv_fetchpvs
++# define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
++#endif
++
++#ifndef gv_stashpvs
++# define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
++#endif
++#ifndef get_cvs
++# define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
++#endif
++#ifndef SvGETMAGIC
++# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
++#endif
++#ifndef PERL_MAGIC_sv
++# define PERL_MAGIC_sv '\0'
++#endif
++
++#ifndef PERL_MAGIC_overload
++# define PERL_MAGIC_overload 'A'
++#endif
++
++#ifndef PERL_MAGIC_overload_elem
++# define PERL_MAGIC_overload_elem 'a'
++#endif
++
++#ifndef PERL_MAGIC_overload_table
++# define PERL_MAGIC_overload_table 'c'
++#endif
++
++#ifndef PERL_MAGIC_bm
++# define PERL_MAGIC_bm 'B'
++#endif
++
++#ifndef PERL_MAGIC_regdata
++# define PERL_MAGIC_regdata 'D'
++#endif
++
++#ifndef PERL_MAGIC_regdatum
++# define PERL_MAGIC_regdatum 'd'
++#endif
++
++#ifndef PERL_MAGIC_env
++# define PERL_MAGIC_env 'E'
++#endif
++
++#ifndef PERL_MAGIC_envelem
++# define PERL_MAGIC_envelem 'e'
++#endif
++
++#ifndef PERL_MAGIC_fm
++# define PERL_MAGIC_fm 'f'
++#endif
++
++#ifndef PERL_MAGIC_regex_global
++# define PERL_MAGIC_regex_global 'g'
++#endif
++
++#ifndef PERL_MAGIC_isa
++# define PERL_MAGIC_isa 'I'
++#endif
++
++#ifndef PERL_MAGIC_isaelem
++# define PERL_MAGIC_isaelem 'i'
++#endif
++
++#ifndef PERL_MAGIC_nkeys
++# define PERL_MAGIC_nkeys 'k'
++#endif
++
++#ifndef PERL_MAGIC_dbfile
++# define PERL_MAGIC_dbfile 'L'
++#endif
++
++#ifndef PERL_MAGIC_dbline
++# define PERL_MAGIC_dbline 'l'
++#endif
++
++#ifndef PERL_MAGIC_mutex
++# define PERL_MAGIC_mutex 'm'
++#endif
++
++#ifndef PERL_MAGIC_shared
++# define PERL_MAGIC_shared 'N'
++#endif
++
++#ifndef PERL_MAGIC_shared_scalar
++# define PERL_MAGIC_shared_scalar 'n'
++#endif
++
++#ifndef PERL_MAGIC_collxfrm
++# define PERL_MAGIC_collxfrm 'o'
++#endif
++
++#ifndef PERL_MAGIC_tied
++# define PERL_MAGIC_tied 'P'
++#endif
++
++#ifndef PERL_MAGIC_tiedelem
++# define PERL_MAGIC_tiedelem 'p'
++#endif
++
++#ifndef PERL_MAGIC_tiedscalar
++# define PERL_MAGIC_tiedscalar 'q'
++#endif
++
++#ifndef PERL_MAGIC_qr
++# define PERL_MAGIC_qr 'r'
++#endif
++
++#ifndef PERL_MAGIC_sig
++# define PERL_MAGIC_sig 'S'
++#endif
++
++#ifndef PERL_MAGIC_sigelem
++# define PERL_MAGIC_sigelem 's'
++#endif
++
++#ifndef PERL_MAGIC_taint
++# define PERL_MAGIC_taint 't'
++#endif
++
++#ifndef PERL_MAGIC_uvar
++# define PERL_MAGIC_uvar 'U'
++#endif
++
++#ifndef PERL_MAGIC_uvar_elem
++# define PERL_MAGIC_uvar_elem 'u'
++#endif
++
++#ifndef PERL_MAGIC_vstring
++# define PERL_MAGIC_vstring 'V'
++#endif
++
++#ifndef PERL_MAGIC_vec
++# define PERL_MAGIC_vec 'v'
++#endif
++
++#ifndef PERL_MAGIC_utf8
++# define PERL_MAGIC_utf8 'w'
++#endif
++
++#ifndef PERL_MAGIC_substr
++# define PERL_MAGIC_substr 'x'
++#endif
++
++#ifndef PERL_MAGIC_defelem
++# define PERL_MAGIC_defelem 'y'
++#endif
++
++#ifndef PERL_MAGIC_glob
++# define PERL_MAGIC_glob '*'
++#endif
++
++#ifndef PERL_MAGIC_arylen
++# define PERL_MAGIC_arylen '#'
++#endif
++
++#ifndef PERL_MAGIC_pos
++# define PERL_MAGIC_pos '.'
++#endif
++
++#ifndef PERL_MAGIC_backref
++# define PERL_MAGIC_backref '<'
++#endif
++
++#ifndef PERL_MAGIC_ext
++# define PERL_MAGIC_ext '~'
++#endif
++
++/* That's the best we can do... */
++#ifndef sv_catpvn_nomg
++# define sv_catpvn_nomg sv_catpvn
++#endif
++
++#ifndef sv_catsv_nomg
++# define sv_catsv_nomg sv_catsv
++#endif
++
++#ifndef sv_setsv_nomg
++# define sv_setsv_nomg sv_setsv
++#endif
++
++#ifndef sv_pvn_nomg
++# define sv_pvn_nomg sv_pvn
++#endif
++
++#ifndef SvIV_nomg
++# define SvIV_nomg SvIV
++#endif
++
++#ifndef SvUV_nomg
++# define SvUV_nomg SvUV
++#endif
++
++#ifndef sv_catpv_mg
++# define sv_catpv_mg(sv, ptr) \
++ STMT_START { \
++ SV *TeMpSv = sv; \
++ sv_catpv(TeMpSv,ptr); \
++ SvSETMAGIC(TeMpSv); \
++ } STMT_END
++#endif
++
++#ifndef sv_catpvn_mg
++# define sv_catpvn_mg(sv, ptr, len) \
++ STMT_START { \
++ SV *TeMpSv = sv; \
++ sv_catpvn(TeMpSv,ptr,len); \
++ SvSETMAGIC(TeMpSv); \
++ } STMT_END
++#endif
++
++#ifndef sv_catsv_mg
++# define sv_catsv_mg(dsv, ssv) \
++ STMT_START { \
++ SV *TeMpSv = dsv; \
++ sv_catsv(TeMpSv,ssv); \
++ SvSETMAGIC(TeMpSv); \
++ } STMT_END
++#endif
++
++#ifndef sv_setiv_mg
++# define sv_setiv_mg(sv, i) \
++ STMT_START { \
++ SV *TeMpSv = sv; \
++ sv_setiv(TeMpSv,i); \
++ SvSETMAGIC(TeMpSv); \
++ } STMT_END
++#endif
++
++#ifndef sv_setnv_mg
++# define sv_setnv_mg(sv, num) \
++ STMT_START { \
++ SV *TeMpSv = sv; \
++ sv_setnv(TeMpSv,num); \
++ SvSETMAGIC(TeMpSv); \
++ } STMT_END
++#endif
++
++#ifndef sv_setpv_mg
++# define sv_setpv_mg(sv, ptr) \
++ STMT_START { \
++ SV *TeMpSv = sv; \
++ sv_setpv(TeMpSv,ptr); \
++ SvSETMAGIC(TeMpSv); \
++ } STMT_END
++#endif
++
++#ifndef sv_setpvn_mg
++# define sv_setpvn_mg(sv, ptr, len) \
++ STMT_START { \
++ SV *TeMpSv = sv; \
++ sv_setpvn(TeMpSv,ptr,len); \
++ SvSETMAGIC(TeMpSv); \
++ } STMT_END
++#endif
++
++#ifndef sv_setsv_mg
++# define sv_setsv_mg(dsv, ssv) \
++ STMT_START { \
++ SV *TeMpSv = dsv; \
++ sv_setsv(TeMpSv,ssv); \
++ SvSETMAGIC(TeMpSv); \
++ } STMT_END
++#endif
++
++#ifndef sv_setuv_mg
++# define sv_setuv_mg(sv, i) \
++ STMT_START { \
++ SV *TeMpSv = sv; \
++ sv_setuv(TeMpSv,i); \
++ SvSETMAGIC(TeMpSv); \
++ } STMT_END
++#endif
++
++#ifndef sv_usepvn_mg
++# define sv_usepvn_mg(sv, ptr, len) \
++ STMT_START { \
++ SV *TeMpSv = sv; \
++ sv_usepvn(TeMpSv,ptr,len); \
++ SvSETMAGIC(TeMpSv); \
++ } STMT_END
++#endif
++#ifndef SvVSTRING_mg
++# define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
++#endif
++
++/* Hint: sv_magic_portable
++ * This is a compatibility function that is only available with
++ * Devel::PPPort. It is NOT in the perl core.
++ * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
++ * it is being passed a name pointer with namlen == 0. In that
++ * case, perl 5.8.0 and later store the pointer, not a copy of it.
++ * The compatibility can be provided back to perl 5.004. With
++ * earlier versions, the code will not compile.
++ */
++
++#if (PERL_BCDVERSION < 0x5004000)
++
++ /* code that uses sv_magic_portable will not compile */
++
++#elif (PERL_BCDVERSION < 0x5008000)
++
++# define sv_magic_portable(sv, obj, how, name, namlen) \
++ STMT_START { \
++ SV *SvMp_sv = (sv); \
++ char *SvMp_name = (char *) (name); \
++ I32 SvMp_namlen = (namlen); \
++ if (SvMp_name && SvMp_namlen == 0) \
++ { \
++ MAGIC *mg; \
++ sv_magic(SvMp_sv, obj, how, 0, 0); \
++ mg = SvMAGIC(SvMp_sv); \
++ mg->mg_len = -42; /* XXX: this is the tricky part */ \
++ mg->mg_ptr = SvMp_name; \
++ } \
++ else \
++ { \
++ sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
++ } \
++ } STMT_END
++
++#else
++
++# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
++
++#endif
++
++#ifdef USE_ITHREADS
++#ifndef CopFILE
++# define CopFILE(c) ((c)->cop_file)
++#endif
++
++#ifndef CopFILEGV
++# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
++#endif
++
++#ifndef CopFILE_set
++# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
++#endif
++
++#ifndef CopFILESV
++# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
++#endif
++
++#ifndef CopFILEAV
++# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
++#endif
++
++#ifndef CopSTASHPV
++# define CopSTASHPV(c) ((c)->cop_stashpv)
++#endif
++
++#ifndef CopSTASHPV_set
++# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
++#endif
++
++#ifndef CopSTASH
++# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
++#endif
++
++#ifndef CopSTASH_set
++# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
++#endif
++
++#ifndef CopSTASH_eq
++# define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
++ || (CopSTASHPV(c) && HvNAME(hv) \
++ && strEQ(CopSTASHPV(c), HvNAME(hv)))))
++#endif
++
++#else
++#ifndef CopFILEGV
++# define CopFILEGV(c) ((c)->cop_filegv)
++#endif
++
++#ifndef CopFILEGV_set
++# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
++#endif
++
++#ifndef CopFILE_set
++# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
++#endif
++
++#ifndef CopFILESV
++# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
++#endif
++
++#ifndef CopFILEAV
++# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
++#endif
++
++#ifndef CopFILE
++# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
++#endif
++
++#ifndef CopSTASH
++# define CopSTASH(c) ((c)->cop_stash)
++#endif
++
++#ifndef CopSTASH_set
++# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
++#endif
++
++#ifndef CopSTASHPV
++# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
++#endif
++
++#ifndef CopSTASHPV_set
++# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
++#endif
++
++#ifndef CopSTASH_eq
++# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
++#endif
++
++#endif /* USE_ITHREADS */
++#ifndef IN_PERL_COMPILETIME
++# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
++#endif
++
++#ifndef IN_LOCALE_RUNTIME
++# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
++#endif
++
++#ifndef IN_LOCALE_COMPILETIME
++# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
++#endif
++
++#ifndef IN_LOCALE
++# define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
++#endif
++#ifndef IS_NUMBER_IN_UV
++# define IS_NUMBER_IN_UV 0x01
++#endif
++
++#ifndef IS_NUMBER_GREATER_THAN_UV_MAX
++# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
++#endif
++
++#ifndef IS_NUMBER_NOT_INT
++# define IS_NUMBER_NOT_INT 0x04
++#endif
++
++#ifndef IS_NUMBER_NEG
++# define IS_NUMBER_NEG 0x08
++#endif
++
++#ifndef IS_NUMBER_INFINITY
++# define IS_NUMBER_INFINITY 0x10
++#endif
++
++#ifndef IS_NUMBER_NAN
++# define IS_NUMBER_NAN 0x20
++#endif
++#ifndef GROK_NUMERIC_RADIX
++# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
++#endif
++#ifndef PERL_SCAN_GREATER_THAN_UV_MAX
++# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
++#endif
++
++#ifndef PERL_SCAN_SILENT_ILLDIGIT
++# define PERL_SCAN_SILENT_ILLDIGIT 0x04
++#endif
++
++#ifndef PERL_SCAN_ALLOW_UNDERSCORES
++# define PERL_SCAN_ALLOW_UNDERSCORES 0x01
++#endif
++
++#ifndef PERL_SCAN_DISALLOW_PREFIX
++# define PERL_SCAN_DISALLOW_PREFIX 0x02
++#endif
++
++#ifndef grok_numeric_radix
++#if defined(NEED_grok_numeric_radix)
++static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
++static
++#else
++extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
++#endif
++
++#ifdef grok_numeric_radix
++# undef grok_numeric_radix
++#endif
++#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
++#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
++
++#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
++bool
++DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
++{
++#ifdef USE_LOCALE_NUMERIC
++#ifdef PL_numeric_radix_sv
++ if (PL_numeric_radix_sv && IN_LOCALE) {
++ STRLEN len;
++ char* radix = SvPV(PL_numeric_radix_sv, len);
++ if (*sp + len <= send && memEQ(*sp, radix, len)) {
++ *sp += len;
++ return TRUE;
++ }
++ }
++#else
++ /* older perls don't have PL_numeric_radix_sv so the radix
++ * must manually be requested from locale.h
++ */
++#include <locale.h>
++ dTHR; /* needed for older threaded perls */
++ struct lconv *lc = localeconv();
++ char *radix = lc->decimal_point;
++ if (radix && IN_LOCALE) {
++ STRLEN len = strlen(radix);
++ if (*sp + len <= send && memEQ(*sp, radix, len)) {
++ *sp += len;
++ return TRUE;
++ }
++ }
++#endif
++#endif /* USE_LOCALE_NUMERIC */
++ /* always try "." if numeric radix didn't match because
++ * we may have data from different locales mixed */
++ if (*sp < send && **sp == '.') {
++ ++*sp;
++ return TRUE;
++ }
++ return FALSE;
++}
++#endif
++#endif
++
++#ifndef grok_number
++#if defined(NEED_grok_number)
++static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
++static
++#else
++extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
++#endif
++
++#ifdef grok_number
++# undef grok_number
++#endif
++#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
++#define Perl_grok_number DPPP_(my_grok_number)
++
++#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
++int
++DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
++{
++ const char *s = pv;
++ const char *send = pv + len;
++ const UV max_div_10 = UV_MAX / 10;
++ const char max_mod_10 = UV_MAX % 10;
++ int numtype = 0;
++ int sawinf = 0;
++ int sawnan = 0;
++
++ while (s < send && isSPACE(*s))
++ s++;
++ if (s == send) {
++ return 0;
++ } else if (*s == '-') {
++ s++;
++ numtype = IS_NUMBER_NEG;
++ }
++ else if (*s == '+')
++ s++;
++
++ if (s == send)
++ return 0;
++
++ /* next must be digit or the radix separator or beginning of infinity */
++ if (isDIGIT(*s)) {
++ /* UVs are at least 32 bits, so the first 9 decimal digits cannot
++ overflow. */
++ UV value = *s - '0';
++ /* This construction seems to be more optimiser friendly.
++ (without it gcc does the isDIGIT test and the *s - '0' separately)
++ With it gcc on arm is managing 6 instructions (6 cycles) per digit.
++ In theory the optimiser could deduce how far to unroll the loop
++ before checking for overflow. */
++ if (++s < send) {
++ int digit = *s - '0';
++ if (digit >= 0 && digit <= 9) {
++ value = value * 10 + digit;
++ if (++s < send) {
++ digit = *s - '0';
++ if (digit >= 0 && digit <= 9) {
++ value = value * 10 + digit;
++ if (++s < send) {
++ digit = *s - '0';
++ if (digit >= 0 && digit <= 9) {
++ value = value * 10 + digit;
++ if (++s < send) {
++ digit = *s - '0';
++ if (digit >= 0 && digit <= 9) {
++ value = value * 10 + digit;
++ if (++s < send) {
++ digit = *s - '0';
++ if (digit >= 0 && digit <= 9) {
++ value = value * 10 + digit;
++ if (++s < send) {
++ digit = *s - '0';
++ if (digit >= 0 && digit <= 9) {
++ value = value * 10 + digit;
++ if (++s < send) {
++ digit = *s - '0';
++ if (digit >= 0 && digit <= 9) {
++ value = value * 10 + digit;
++ if (++s < send) {
++ digit = *s - '0';
++ if (digit >= 0 && digit <= 9) {
++ value = value * 10 + digit;
++ if (++s < send) {
++ /* Now got 9 digits, so need to check
++ each time for overflow. */
++ digit = *s - '0';
++ while (digit >= 0 && digit <= 9
++ && (value < max_div_10
++ || (value == max_div_10
++ && digit <= max_mod_10))) {
++ value = value * 10 + digit;
++ if (++s < send)
++ digit = *s - '0';
++ else
++ break;
++ }
++ if (digit >= 0 && digit <= 9
++ && (s < send)) {
++ /* value overflowed.
++ skip the remaining digits, don't
++ worry about setting *valuep. */
++ do {
++ s++;
++ } while (s < send && isDIGIT(*s));
++ numtype |=
++ IS_NUMBER_GREATER_THAN_UV_MAX;
++ goto skip_value;
++ }
++ }
++ }
++ }
++ }
++ }
++ }
++ }
++ }
++ }
++ }
++ }
++ }
++ }
++ }
++ }
++ }
++ }
++ numtype |= IS_NUMBER_IN_UV;
++ if (valuep)
++ *valuep = value;
++
++ skip_value:
++ if (GROK_NUMERIC_RADIX(&s, send)) {
++ numtype |= IS_NUMBER_NOT_INT;
++ while (s < send && isDIGIT(*s)) /* optional digits after the radix */
++ s++;
++ }
++ }
++ else if (GROK_NUMERIC_RADIX(&s, send)) {
++ numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
++ /* no digits before the radix means we need digits after it */
++ if (s < send && isDIGIT(*s)) {
++ do {
++ s++;
++ } while (s < send && isDIGIT(*s));
++ if (valuep) {
++ /* integer approximation is valid - it's 0. */
++ *valuep = 0;
++ }
++ }
++ else
++ return 0;
++ } else if (*s == 'I' || *s == 'i') {
++ s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
++ s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
++ s++; if (s < send && (*s == 'I' || *s == 'i')) {
++ s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
++ s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
++ s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
++ s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
++ s++;
++ }
++ sawinf = 1;
++ } else if (*s == 'N' || *s == 'n') {
++ /* XXX TODO: There are signaling NaNs and quiet NaNs. */
++ s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
++ s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
++ s++;
++ sawnan = 1;
++ } else
++ return 0;
++
++ if (sawinf) {
++ numtype &= IS_NUMBER_NEG; /* Keep track of sign */
++ numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
++ } else if (sawnan) {
++ numtype &= IS_NUMBER_NEG; /* Keep track of sign */
++ numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
++ } else if (s < send) {
++ /* we can have an optional exponent part */
++ if (*s == 'e' || *s == 'E') {
++ /* The only flag we keep is sign. Blow away any "it's UV" */
++ numtype &= IS_NUMBER_NEG;
++ numtype |= IS_NUMBER_NOT_INT;
++ s++;
++ if (s < send && (*s == '-' || *s == '+'))
++ s++;
++ if (s < send && isDIGIT(*s)) {
++ do {
++ s++;
++ } while (s < send && isDIGIT(*s));
++ }
++ else
++ return 0;
++ }
++ }
++ while (s < send && isSPACE(*s))
++ s++;
++ if (s >= send)
++ return numtype;
++ if (len == 10 && memEQ(pv, "0 but true", 10)) {
++ if (valuep)
++ *valuep = 0;
++ return IS_NUMBER_IN_UV;
++ }
++ return 0;
++}
++#endif
++#endif
++
++/*
++ * The grok_* routines have been modified to use warn() instead of
++ * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
++ * which is why the stack variable has been renamed to 'xdigit'.
++ */
++
++#ifndef grok_bin
++#if defined(NEED_grok_bin)
++static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
++static
++#else
++extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
++#endif
++
++#ifdef grok_bin
++# undef grok_bin
++#endif
++#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
++#define Perl_grok_bin DPPP_(my_grok_bin)
++
++#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
++UV
++DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
++{
++ const char *s = start;
++ STRLEN len = *len_p;
++ UV value = 0;
++ NV value_nv = 0;
++
++ const UV max_div_2 = UV_MAX / 2;
++ bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
++ bool overflowed = FALSE;
++
++ if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
++ /* strip off leading b or 0b.
++ for compatibility silently suffer "b" and "0b" as valid binary
++ numbers. */
++ if (len >= 1) {
++ if (s[0] == 'b') {
++ s++;
++ len--;
++ }
++ else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
++ s+=2;
++ len-=2;
++ }
++ }
++ }
++
++ for (; len-- && *s; s++) {
++ char bit = *s;
++ if (bit == '0' || bit == '1') {
++ /* Write it in this wonky order with a goto to attempt to get the
++ compiler to make the common case integer-only loop pretty tight.
++ With gcc seems to be much straighter code than old scan_bin. */
++ redo:
++ if (!overflowed) {
++ if (value <= max_div_2) {
++ value = (value << 1) | (bit - '0');
++ continue;
++ }
++ /* Bah. We're just overflowed. */
++ warn("Integer overflow in binary number");
++ overflowed = TRUE;
++ value_nv = (NV) value;
++ }
++ value_nv *= 2.0;
++ /* If an NV has not enough bits in its mantissa to
++ * represent a UV this summing of small low-order numbers
++ * is a waste of time (because the NV cannot preserve
++ * the low-order bits anyway): we could just remember when
++ * did we overflow and in the end just multiply value_nv by the
++ * right amount. */
++ value_nv += (NV)(bit - '0');
++ continue;
++ }
++ if (bit == '_' && len && allow_underscores && (bit = s[1])
++ && (bit == '0' || bit == '1'))
++ {
++ --len;
++ ++s;
++ goto redo;
++ }
++ if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
++ warn("Illegal binary digit '%c' ignored", *s);
++ break;
++ }
++
++ if ( ( overflowed && value_nv > 4294967295.0)
++#if UVSIZE > 4
++ || (!overflowed && value > 0xffffffff )
++#endif
++ ) {
++ warn("Binary number > 0b11111111111111111111111111111111 non-portable");
++ }
++ *len_p = s - start;
++ if (!overflowed) {
++ *flags = 0;
++ return value;
++ }
++ *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
++ if (result)
++ *result = value_nv;
++ return UV_MAX;
++}
++#endif
++#endif
++
++#ifndef grok_hex
++#if defined(NEED_grok_hex)
++static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
++static
++#else
++extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
++#endif
++
++#ifdef grok_hex
++# undef grok_hex
++#endif
++#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
++#define Perl_grok_hex DPPP_(my_grok_hex)
++
++#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
++UV
++DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
++{
++ const char *s = start;
++ STRLEN len = *len_p;
++ UV value = 0;
++ NV value_nv = 0;
++
++ const UV max_div_16 = UV_MAX / 16;
++ bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
++ bool overflowed = FALSE;
++ const char *xdigit;
++
++ if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
++ /* strip off leading x or 0x.
++ for compatibility silently suffer "x" and "0x" as valid hex numbers.
++ */
++ if (len >= 1) {
++ if (s[0] == 'x') {
++ s++;
++ len--;
++ }
++ else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
++ s+=2;
++ len-=2;
++ }
++ }
++ }
++
++ for (; len-- && *s; s++) {
++ xdigit = strchr((char *) PL_hexdigit, *s);
++ if (xdigit) {
++ /* Write it in this wonky order with a goto to attempt to get the
++ compiler to make the common case integer-only loop pretty tight.
++ With gcc seems to be much straighter code than old scan_hex. */
++ redo:
++ if (!overflowed) {
++ if (value <= max_div_16) {
++ value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
++ continue;
++ }
++ warn("Integer overflow in hexadecimal number");
++ overflowed = TRUE;
++ value_nv = (NV) value;
++ }
++ value_nv *= 16.0;
++ /* If an NV has not enough bits in its mantissa to
++ * represent a UV this summing of small low-order numbers
++ * is a waste of time (because the NV cannot preserve
++ * the low-order bits anyway): we could just remember when
++ * did we overflow and in the end just multiply value_nv by the
++ * right amount of 16-tuples. */
++ value_nv += (NV)((xdigit - PL_hexdigit) & 15);
++ continue;
++ }
++ if (*s == '_' && len && allow_underscores && s[1]
++ && (xdigit = strchr((char *) PL_hexdigit, s[1])))
++ {
++ --len;
++ ++s;
++ goto redo;
++ }
++ if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
++ warn("Illegal hexadecimal digit '%c' ignored", *s);
++ break;
++ }
++
++ if ( ( overflowed && value_nv > 4294967295.0)
++#if UVSIZE > 4
++ || (!overflowed && value > 0xffffffff )
++#endif
++ ) {
++ warn("Hexadecimal number > 0xffffffff non-portable");
++ }
++ *len_p = s - start;
++ if (!overflowed) {
++ *flags = 0;
++ return value;
++ }
++ *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
++ if (result)
++ *result = value_nv;
++ return UV_MAX;
++}
++#endif
++#endif
++
++#ifndef grok_oct
++#if defined(NEED_grok_oct)
++static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
++static
++#else
++extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
++#endif
++
++#ifdef grok_oct
++# undef grok_oct
++#endif
++#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
++#define Perl_grok_oct DPPP_(my_grok_oct)
++
++#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
++UV
++DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
++{
++ const char *s = start;
++ STRLEN len = *len_p;
++ UV value = 0;
++ NV value_nv = 0;
++
++ const UV max_div_8 = UV_MAX / 8;
++ bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
++ bool overflowed = FALSE;
++
++ for (; len-- && *s; s++) {
++ /* gcc 2.95 optimiser not smart enough to figure that this subtraction
++ out front allows slicker code. */
++ int digit = *s - '0';
++ if (digit >= 0 && digit <= 7) {
++ /* Write it in this wonky order with a goto to attempt to get the
++ compiler to make the common case integer-only loop pretty tight.
++ */
++ redo:
++ if (!overflowed) {
++ if (value <= max_div_8) {
++ value = (value << 3) | digit;
++ continue;
++ }
++ /* Bah. We're just overflowed. */
++ warn("Integer overflow in octal number");
++ overflowed = TRUE;
++ value_nv = (NV) value;
++ }
++ value_nv *= 8.0;
++ /* If an NV has not enough bits in its mantissa to
++ * represent a UV this summing of small low-order numbers
++ * is a waste of time (because the NV cannot preserve
++ * the low-order bits anyway): we could just remember when
++ * did we overflow and in the end just multiply value_nv by the
++ * right amount of 8-tuples. */
++ value_nv += (NV)digit;
++ continue;
++ }
++ if (digit == ('_' - '0') && len && allow_underscores
++ && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
++ {
++ --len;
++ ++s;
++ goto redo;
++ }
++ /* Allow \octal to work the DWIM way (that is, stop scanning
++ * as soon as non-octal characters are seen, complain only iff
++ * someone seems to want to use the digits eight and nine). */
++ if (digit == 8 || digit == 9) {
++ if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
++ warn("Illegal octal digit '%c' ignored", *s);
++ }
++ break;
++ }
++
++ if ( ( overflowed && value_nv > 4294967295.0)
++#if UVSIZE > 4
++ || (!overflowed && value > 0xffffffff )
++#endif
++ ) {
++ warn("Octal number > 037777777777 non-portable");
++ }
++ *len_p = s - start;
++ if (!overflowed) {
++ *flags = 0;
++ return value;
++ }
++ *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
++ if (result)
++ *result = value_nv;
++ return UV_MAX;
++}
++#endif
++#endif
++
++#if !defined(my_snprintf)
++#if defined(NEED_my_snprintf)
++static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
++static
++#else
++extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
++#endif
++
++#define my_snprintf DPPP_(my_my_snprintf)
++#define Perl_my_snprintf DPPP_(my_my_snprintf)
++
++#if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
++
++int
++DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
++{
++ dTHX;
++ int retval;
++ va_list ap;
++ va_start(ap, format);
++#ifdef HAS_VSNPRINTF
++ retval = vsnprintf(buffer, len, format, ap);
++#else
++ retval = vsprintf(buffer, format, ap);
++#endif
++ va_end(ap);
++ if (retval < 0 || (len > 0 && (Size_t)retval >= len))
++ Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
++ return retval;
++}
++
++#endif
++#endif
++
++#if !defined(my_sprintf)
++#if defined(NEED_my_sprintf)
++static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
++static
++#else
++extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
++#endif
++
++#define my_sprintf DPPP_(my_my_sprintf)
++#define Perl_my_sprintf DPPP_(my_my_sprintf)
++
++#if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
++
++int
++DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
++{
++ va_list args;
++ va_start(args, pat);
++ vsprintf(buffer, pat, args);
++ va_end(args);
++ return strlen(buffer);
++}
++
++#endif
++#endif
++
++#ifdef NO_XSLOCKS
++# ifdef dJMPENV
++# define dXCPT dJMPENV; int rEtV = 0
++# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
++# define XCPT_TRY_END JMPENV_POP;
++# define XCPT_CATCH if (rEtV != 0)
++# define XCPT_RETHROW JMPENV_JUMP(rEtV)
++# else
++# define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
++# define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
++# define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
++# define XCPT_CATCH if (rEtV != 0)
++# define XCPT_RETHROW Siglongjmp(top_env, rEtV)
++# endif
++#endif
++
++#if !defined(my_strlcat)
++#if defined(NEED_my_strlcat)
++static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
++static
++#else
++extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
++#endif
++
++#define my_strlcat DPPP_(my_my_strlcat)
++#define Perl_my_strlcat DPPP_(my_my_strlcat)
++
++#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
++
++Size_t
++DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
++{
++ Size_t used, length, copy;
++
++ used = strlen(dst);
++ length = strlen(src);
++ if (size > 0 && used < size - 1) {
++ copy = (length >= size - used) ? size - used - 1 : length;
++ memcpy(dst + used, src, copy);
++ dst[used + copy] = '\0';
++ }
++ return used + length;
++}
++#endif
++#endif
++
++#if !defined(my_strlcpy)
++#if defined(NEED_my_strlcpy)
++static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
++static
++#else
++extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
++#endif
++
++#define my_strlcpy DPPP_(my_my_strlcpy)
++#define Perl_my_strlcpy DPPP_(my_my_strlcpy)
++
++#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
++
++Size_t
++DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
++{
++ Size_t length, copy;
++
++ length = strlen(src);
++ if (size > 0) {
++ copy = (length >= size) ? size - 1 : length;
++ memcpy(dst, src, copy);
++ dst[copy] = '\0';
++ }
++ return length;
++}
++
++#endif
++#endif
++#ifndef PERL_PV_ESCAPE_QUOTE
++# define PERL_PV_ESCAPE_QUOTE 0x0001
++#endif
++
++#ifndef PERL_PV_PRETTY_QUOTE
++# define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
++#endif
++
++#ifndef PERL_PV_PRETTY_ELLIPSES
++# define PERL_PV_PRETTY_ELLIPSES 0x0002
++#endif
++
++#ifndef PERL_PV_PRETTY_LTGT
++# define PERL_PV_PRETTY_LTGT 0x0004
++#endif
++
++#ifndef PERL_PV_ESCAPE_FIRSTCHAR
++# define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
++#endif
++
++#ifndef PERL_PV_ESCAPE_UNI
++# define PERL_PV_ESCAPE_UNI 0x0100
++#endif
++
++#ifndef PERL_PV_ESCAPE_UNI_DETECT
++# define PERL_PV_ESCAPE_UNI_DETECT 0x0200
++#endif
++
++#ifndef PERL_PV_ESCAPE_ALL
++# define PERL_PV_ESCAPE_ALL 0x1000
++#endif
++
++#ifndef PERL_PV_ESCAPE_NOBACKSLASH
++# define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
++#endif
++
++#ifndef PERL_PV_ESCAPE_NOCLEAR
++# define PERL_PV_ESCAPE_NOCLEAR 0x4000
++#endif
++
++#ifndef PERL_PV_ESCAPE_RE
++# define PERL_PV_ESCAPE_RE 0x8000
++#endif
++
++#ifndef PERL_PV_PRETTY_NOCLEAR
++# define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
++#endif
++#ifndef PERL_PV_PRETTY_DUMP
++# define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
++#endif
++
++#ifndef PERL_PV_PRETTY_REGPROP
++# define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
++#endif
++
++/* Hint: pv_escape
++ * Note that unicode functionality is only backported to
++ * those perl versions that support it. For older perl
++ * versions, the implementation will fall back to bytes.
++ */
++
++#ifndef pv_escape
++#if defined(NEED_pv_escape)
++static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
++static
++#else
++extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
++#endif
++
++#ifdef pv_escape
++# undef pv_escape
++#endif
++#define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
++#define Perl_pv_escape DPPP_(my_pv_escape)
++
++#if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
++
++char *
++DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
++ const STRLEN count, const STRLEN max,
++ STRLEN * const escaped, const U32 flags)
++{
++ const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
++ const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
++ char octbuf[32] = "%123456789ABCDF";
++ STRLEN wrote = 0;
++ STRLEN chsize = 0;
++ STRLEN readsize = 1;
++#if defined(is_utf8_string) && defined(utf8_to_uvchr)
++ bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
++#endif
++ const char *pv = str;
++ const char * const end = pv + count;
++ octbuf[0] = esc;
++
++ if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
++ sv_setpvs(dsv, "");
++
++#if defined(is_utf8_string) && defined(utf8_to_uvchr)
++ if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
++ isuni = 1;
++#endif
++
++ for (; pv < end && (!max || wrote < max) ; pv += readsize) {
++ const UV u =
++#if defined(is_utf8_string) && defined(utf8_to_uvchr)
++ isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
++#endif
++ (U8)*pv;
++ const U8 c = (U8)u & 0xFF;
++
++ if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
++ if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
++ chsize = my_snprintf(octbuf, sizeof octbuf,
++ "%"UVxf, u);
++ else
++ chsize = my_snprintf(octbuf, sizeof octbuf,
++ "%cx{%"UVxf"}", esc, u);
++ } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
++ chsize = 1;
++ } else {
++ if (c == dq || c == esc || !isPRINT(c)) {
++ chsize = 2;
++ switch (c) {
++ case '\\' : /* fallthrough */
++ case '%' : if (c == esc)
++ octbuf[1] = esc;
++ else
++ chsize = 1;
++ break;
++ case '\v' : octbuf[1] = 'v'; break;
++ case '\t' : octbuf[1] = 't'; break;
++ case '\r' : octbuf[1] = 'r'; break;
++ case '\n' : octbuf[1] = 'n'; break;
++ case '\f' : octbuf[1] = 'f'; break;
++ case '"' : if (dq == '"')
++ octbuf[1] = '"';
++ else
++ chsize = 1;
++ break;
++ default: chsize = my_snprintf(octbuf, sizeof octbuf,
++ pv < end && isDIGIT((U8)*(pv+readsize))
++ ? "%c%03o" : "%c%o", esc, c);
++ }
++ } else {
++ chsize = 1;
++ }
++ }
++ if (max && wrote + chsize > max) {
++ break;
++ } else if (chsize > 1) {
++ sv_catpvn(dsv, octbuf, chsize);
++ wrote += chsize;
++ } else {
++ char tmp[2];
++ my_snprintf(tmp, sizeof tmp, "%c", c);
++ sv_catpvn(dsv, tmp, 1);
++ wrote++;
++ }
++ if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
++ break;
++ }
++ if (escaped != NULL)
++ *escaped= pv - str;
++ return SvPVX(dsv);
++}
++
++#endif
++#endif
++
++#ifndef pv_pretty
++#if defined(NEED_pv_pretty)
++static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
++static
++#else
++extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
++#endif
++
++#ifdef pv_pretty
++# undef pv_pretty
++#endif
++#define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
++#define Perl_pv_pretty DPPP_(my_pv_pretty)
++
++#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
++
++char *
++DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
++ const STRLEN max, char const * const start_color, char const * const end_color,
++ const U32 flags)
++{
++ const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
++ STRLEN escaped;
++
++ if (!(flags & PERL_PV_PRETTY_NOCLEAR))
++ sv_setpvs(dsv, "");
++
++ if (dq == '"')
++ sv_catpvs(dsv, "\"");
++ else if (flags & PERL_PV_PRETTY_LTGT)
++ sv_catpvs(dsv, "<");
++
++ if (start_color != NULL)
++ sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
++
++ pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
++
++ if (end_color != NULL)
++ sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
++
++ if (dq == '"')
++ sv_catpvs(dsv, "\"");
++ else if (flags & PERL_PV_PRETTY_LTGT)
++ sv_catpvs(dsv, ">");
++
++ if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
++ sv_catpvs(dsv, "...");
++
++ return SvPVX(dsv);
++}
++
++#endif
++#endif
++
++#ifndef pv_display
++#if defined(NEED_pv_display)
++static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
++static
++#else
++extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
++#endif
++
++#ifdef pv_display
++# undef pv_display
++#endif
++#define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
++#define Perl_pv_display DPPP_(my_pv_display)
++
++#if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
++
++char *
++DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
++{
++ pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
++ if (len > cur && pv[cur] == '\0')
++ sv_catpvs(dsv, "\\0");
++ return SvPVX(dsv);
++}
++
++#endif
++#endif
++
++#endif /* _P_P_PORTABILITY_H_ */
++
++/* End of File ppport.h */
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/bless_var_method.t perl-5.12.5_dumper/dist/Data-Dumper/t/bless_var_method.t
+--- perl-5.12.5/dist/Data-Dumper/t/bless_var_method.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/bless_var_method.t 2014-10-09 15:06:36.175627384 -0400
+@@ -0,0 +1,86 @@
++#!./perl -w
++# t/bless.t - Test Bless()
++
++BEGIN {
++ if ($ENV{PERL_CORE}){
++ require Config; import Config;
++ no warnings 'once';
++ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
++ print "1..0 # Skip: Data::Dumper was not built\n";
++ exit 0;
++ }
++ }
++}
++
++use strict;
++
++use Data::Dumper;
++use Test::More tests => 8;
++use lib qw( ./t/lib );
++use Testing qw( _dumptostr );
++
++my %d = (
++ delta => 'd',
++ beta => 'b',
++ gamma => 'c',
++ alpha => 'a',
++);
++
++run_tests_for_bless_var_method();
++SKIP: {
++ skip "XS version was unavailable, so we already ran with pure Perl", 4
++ if $Data::Dumper::Useperl;
++ local $Data::Dumper::Useperl = 1;
++ run_tests_for_bless_var_method();
++}
++
++sub run_tests_for_bless_var_method {
++ my ($obj, %dumps, $bless, $starting);
++
++ note("\$Data::Dumper::Bless and Bless() set to true value");
++
++ $starting = $Data::Dumper::Bless;
++ $bless = 1;
++ local $Data::Dumper::Bless = $bless;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddblessone'} = _dumptostr($obj);
++ local $Data::Dumper::Bless = $starting;
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $obj->Bless($bless);
++ $dumps{'objblessone'} = _dumptostr($obj);
++
++ is($dumps{'ddblessone'}, $dumps{'objblessone'},
++ "\$Data::Dumper::Bless = 1 and Bless(1) are equivalent");
++ %dumps = ();
++
++ $bless = 0;
++ local $Data::Dumper::Bless = $bless;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddblesszero'} = _dumptostr($obj);
++ local $Data::Dumper::Bless = $starting;
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $obj->Bless($bless);
++ $dumps{'objblesszero'} = _dumptostr($obj);
++
++ is($dumps{'ddblesszero'}, $dumps{'objblesszero'},
++ "\$Data::Dumper::Bless = 0 and Bless(0) are equivalent");
++
++ $bless = undef;
++ local $Data::Dumper::Bless = $bless;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddblessundef'} = _dumptostr($obj);
++ local $Data::Dumper::Bless = $starting;
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $obj->Bless($bless);
++ $dumps{'objblessundef'} = _dumptostr($obj);
++
++ is($dumps{'ddblessundef'}, $dumps{'objblessundef'},
++ "\$Data::Dumper::Bless = undef and Bless(undef) are equivalent");
++ is($dumps{'ddblesszero'}, $dumps{'objblessundef'},
++ "\$Data::Dumper::Bless = undef and = 0 are equivalent");
++ %dumps = ();
++}
++
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/bless.t perl-5.12.5_dumper/dist/Data-Dumper/t/bless.t
+--- perl-5.12.5/dist/Data-Dumper/t/bless.t 2012-11-03 19:25:59.000000000 -0400
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/bless.t 2014-10-09 15:06:36.178706635 -0400
+@@ -5,16 +5,22 @@
+ # Test::More 0.60 required because:
+ # - is_deeply(undef, $not_undef); now works. [rt.cpan.org 9441]
+
+-BEGIN { plan tests => 1+5*2; }
++BEGIN { plan tests => 1+2*5; }
+
+ BEGIN { use_ok('Data::Dumper') };
+
+ # RT 39420: Data::Dumper fails to escape bless class name
+
+-# test under XS and pure Perl version
+-foreach $Data::Dumper::Useperl (0, 1) {
++run_tests_for_bless();
++SKIP: {
++ skip "XS version was unavailable, so we already ran with pure Perl", 5
++ if $Data::Dumper::Useperl;
++ local $Data::Dumper::Useperl = 1;
++ run_tests_for_bless();
++}
+
+-#diag("\$Data::Dumper::Useperl = $Data::Dumper::Useperl");
++sub run_tests_for_bless {
++note("\$Data::Dumper::Useperl = $Data::Dumper::Useperl");
+
+ {
+ my $t = bless( {}, q{a'b} );
+@@ -43,11 +49,14 @@
+
+ my $t = bless( qr//, 'foo');
+ my $dt = Dumper($t);
+-my $o = <<'PERL';
+-$VAR1 = bless( qr/(?-xism:)/, 'foo' );
++my $o = ($] > 5.010 ? <<'PERL' : <<'PERL_LEGACY');
++$VAR1 = bless( qr//, 'foo' );
+ PERL
++$VAR1 = bless( qr/(?-xism:)/, 'foo' );
++PERL_LEGACY
+
+ is($dt, $o, "We can dump blessed qr//'s properly");
+
+ }
+-}
++
++} # END sub run_tests_for_bless()
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/bugs.t perl-5.12.5_dumper/dist/Data-Dumper/t/bugs.t
+--- perl-5.12.5/dist/Data-Dumper/t/bugs.t 2012-11-03 19:25:59.000000000 -0400
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/bugs.t 2014-10-09 15:06:36.177067555 -0400
+@@ -1,6 +1,6 @@
+ #!perl
+ #
+-# regression tests for old bugs that don't fit other categories
++# regression tests for old bugs that do not fit other categories
+
+ BEGIN {
+ require Config; import Config;
+@@ -12,7 +12,7 @@
+ }
+
+ use strict;
+-use Test::More tests => 5;
++use Test::More tests => 15;
+ use Data::Dumper;
+
+ {
+@@ -80,4 +80,68 @@
+ doh('fixed');
+ ok(1, "[perl #56766]"); # Still no core dump? We are fine.
+
++SKIP: {
++ skip "perl 5.10.1 crashes and DD cannot help it", 1 if $] < 5.0119999;
++ # [perl #72332] Segfault on empty-string glob
++ Data::Dumper->Dump([*{*STDERR{IO}}]);
++ ok("ok", #ok
++ "empty-string glob [perl #72332]");
++}
++
++# writing out of bounds with malformed utf8
++SKIP: {
++ eval { require Encode };
++ skip("Encode not available", 1) if $@;
++ local $^W=1;
++ local $SIG{__WARN__} = sub {};
++ my $a="\x{fc}'" x 50;
++ Encode::_utf8_on($a);
++ Dumper $a;
++ ok("ok", "no crash dumping malformed utf8 with the utf8 flag on");
++}
++
++{
++ # We have to test reference equivalence, rather than actual output, as
++ # Perl itself is buggy prior to 5.15.6. Output from DD should at least
++ # evaluate to the same typeglob, regardless of perl bugs.
++ my $tests = sub {
++ my $VAR1;
++ no strict 'refs';
++ is eval(Dumper \*{"foo::b\0ar"}), \*{"foo::b\0ar"},
++ 'GVs with nulls';
++ # There is a strange 5.6 bug that causes the eval to fail a supposed
++ # strict vars test (involving $VAR1). Mentioning the glob beforehand
++ # somehow makes it go away.
++ () = \*{chr 256};
++ is eval Dumper(\*{chr 256})||die ($@), \*{chr 256},
++ 'GVs with UTF8 names (or not, depending on perl version)';
++ () = \*{"\0".chr 256}; # same bug
++ is eval Dumper(\*{"\0".chr 256}), \*{"\0".chr 256},
++ 'GVs with UTF8 and nulls';
++ };
++ SKIP: {
++ skip "no XS", 3 if not defined &Data::Dumper::Dumpxs;
++ local $Data::Dumper::Useperl = 0;
++ &$tests;
++ }
++ local $Data::Dumper::Useperl = 1;
++ &$tests;
++}
++
++{
++ # Test reference equivalence of dumping *{""}.
++ my $tests = sub {
++ my $VAR1;
++ no strict 'refs';
++ is eval(Dumper \*{""}), \*{""}, 'dumping \*{""}';
++ };
++ SKIP: {
++ skip "no XS", 1 if not defined &Data::Dumper::Dumpxs;
++ local $Data::Dumper::Useperl = 0;
++ &$tests;
++ }
++ local $Data::Dumper::Useperl = 1;
++ &$tests;
++}
++
+ # EOF
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/deparse.t perl-5.12.5_dumper/dist/Data-Dumper/t/deparse.t
+--- perl-5.12.5/dist/Data-Dumper/t/deparse.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/deparse.t 2014-10-09 15:06:36.176803024 -0400
+@@ -0,0 +1,80 @@
++#!./perl -w
++# t/deparse.t - Test Deparse()
++
++BEGIN {
++ if ($ENV{PERL_CORE}){
++ require Config; import Config;
++ no warnings 'once';
++ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
++ print "1..0 # Skip: Data::Dumper was not built\n";
++ exit 0;
++ }
++ }
++}
++
++use strict;
++
++use Data::Dumper;
++use Test::More tests => 8;
++use lib qw( ./t/lib );
++use Testing qw( _dumptostr );
++
++# Thanks to Arthur Axel "fREW" Schmidt:
++# http://search.cpan.org/~frew/Data-Dumper-Concise-2.020/lib/Data/Dumper/Concise.pm
++
++note("\$Data::Dumper::Deparse and Deparse()");
++
++{
++ my ($obj, %dumps, $deparse, $starting);
++ use strict;
++ my $struct = { foo => "bar\nbaz", quux => sub { "fleem" } };
++ $obj = Data::Dumper->new( [ $struct ] );
++ $dumps{'noprev'} = _dumptostr($obj);
++
++ $starting = $Data::Dumper::Deparse;
++ local $Data::Dumper::Deparse = 0;
++ $obj = Data::Dumper->new( [ $struct ] );
++ $dumps{'dddzero'} = _dumptostr($obj);
++ local $Data::Dumper::Deparse = $starting;
++
++ $obj = Data::Dumper->new( [ $struct ] );
++ $obj->Deparse();
++ $dumps{'objempty'} = _dumptostr($obj);
++
++ $obj = Data::Dumper->new( [ $struct ] );
++ $obj->Deparse(0);
++ $dumps{'objzero'} = _dumptostr($obj);
++
++ is($dumps{'noprev'}, $dumps{'dddzero'},
++ "No previous setting and \$Data::Dumper::Deparse = 0 are equivalent");
++ is($dumps{'noprev'}, $dumps{'objempty'},
++ "No previous setting and Deparse() are equivalent");
++ is($dumps{'noprev'}, $dumps{'objzero'},
++ "No previous setting and Deparse(0) are equivalent");
++
++ local $Data::Dumper::Deparse = 1;
++ $obj = Data::Dumper->new( [ $struct ] );
++ $dumps{'dddtrue'} = _dumptostr($obj);
++ local $Data::Dumper::Deparse = $starting;
++
++ $obj = Data::Dumper->new( [ $struct ] );
++ $obj->Deparse(1);
++ $dumps{'objone'} = _dumptostr($obj);
++
++ is($dumps{'dddtrue'}, $dumps{'objone'},
++ "\$Data::Dumper::Deparse = 1 and Deparse(1) are equivalent");
++
++ isnt($dumps{'dddzero'}, $dumps{'dddtrue'},
++ "\$Data::Dumper::Deparse = 0 differs from \$Data::Dumper::Deparse = 1");
++
++ like($dumps{'dddzero'},
++ qr/quux.*?sub.*?DUMMY/s,
++ "\$Data::Dumper::Deparse = 0 reports DUMMY instead of deparsing coderef");
++ unlike($dumps{'dddtrue'},
++ qr/quux.*?sub.*?DUMMY/s,
++ "\$Data::Dumper::Deparse = 1 does not report DUMMY");
++ like($dumps{'dddtrue'},
++ qr/quux.*?sub.*?use\sstrict.*?fleem/s,
++ "\$Data::Dumper::Deparse = 1 deparses coderef");
++}
++
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/dumper.t perl-5.12.5_dumper/dist/Data-Dumper/t/dumper.t
+--- perl-5.12.5/dist/Data-Dumper/t/dumper.t 2012-11-03 19:25:59.000000000 -0400
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/dumper.t 2014-10-09 15:06:36.180643046 -0400
+@@ -30,44 +30,44 @@
+ my $t = eval $string;
+ ++$TNUM;
+ $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
+- if ($WANT =~ /deadbeef/);
++ if ($WANT =~ /deadbeef/);
+ if ($Is_ebcdic) {
+- # these data need massaging with non ascii character sets
+- # because of hashing order differences
+- $WANT = join("\n",sort(split(/\n/,$WANT)));
+- $WANT =~ s/\,$//mg;
+- $t = join("\n",sort(split(/\n/,$t)));
+- $t =~ s/\,$//mg;
++ # these data need massaging with non ascii character sets
++ # because of hashing order differences
++ $WANT = join("\n",sort(split(/\n/,$WANT)));
++ $WANT =~ s/\,$//mg;
++ $t = join("\n",sort(split(/\n/,$t)));
++ $t =~ s/\,$//mg;
+ }
+ $name = $name ? " - $name" : '';
+ print( ($t eq $WANT and not $@) ? "ok $TNUM$name\n"
+- : "not ok $TNUM$name\n--Expected--\n$WANT\n--Got--\n$@$t\n");
++ : "not ok $TNUM$name\n--Expected--\n$WANT\n--Got--\n$@$t\n");
+
+ ++$TNUM;
+ if ($Is_ebcdic) { # EBCDIC.
+- if ($TNUM == 311 || $TNUM == 314) {
+- eval $string;
+- } else {
+- eval $t;
+- }
++ if ($TNUM == 311 || $TNUM == 314) {
++ eval $string;
++ } else {
++ eval $t;
++ }
+ } else {
+- eval "$t";
++ eval "$t";
+ }
+ print $@ ? "not ok $TNUM\n# \$@ says: $@\n" : "ok $TNUM\n";
+
+ $t = eval $string;
+ ++$TNUM;
+ $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
+- if ($WANT =~ /deadbeef/);
++ if ($WANT =~ /deadbeef/);
+ if ($Is_ebcdic) {
+- # here too there are hashing order differences
+- $WANT = join("\n",sort(split(/\n/,$WANT)));
+- $WANT =~ s/\,$//mg;
+- $t = join("\n",sort(split(/\n/,$t)));
+- $t =~ s/\,$//mg;
++ # here too there are hashing order differences
++ $WANT = join("\n",sort(split(/\n/,$WANT)));
++ $WANT =~ s/\,$//mg;
++ $t = join("\n",sort(split(/\n/,$t)));
++ $t =~ s/\,$//mg;
+ }
+ print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
+- : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
++ : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
+ }
+
+ sub SKIP_TEST {
+@@ -83,11 +83,11 @@
+ $Data::Dumper::Useperl = 1;
+ if (defined &Data::Dumper::Dumpxs) {
+ print "### XS extension loaded, will run XS tests\n";
+- $TMAX = 363; $XS = 1;
++ $TMAX = 438; $XS = 1;
+ }
+ else {
+ print "### XS extensions not loaded, will NOT run XS tests\n";
+- $TMAX = 183; $XS = 0;
++ $TMAX = 219; $XS = 0;
+ }
+
+ print "1..$TMAX\n";
+@@ -122,8 +122,20 @@
+ #$6 = $a->[1]{'c'};
+ EOT
+
+-TEST q(Data::Dumper->Dump([$a,$b,$c], [qw(a b), 6]));
+-TEST q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b), 6])) if $XS;
++TEST (q(Data::Dumper->Dump([$a,$b,$c], [qw(a b), 6])),
++ 'basic test with names: Dump()');
++TEST (q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b), 6])),
++ 'basic test with names: Dumpxs()')
++ if $XS;
++
++SCOPE: {
++ local $Data::Dumper::Sparseseen = 1;
++ TEST (q(Data::Dumper->Dump([$a,$b,$c], [qw(a b), 6])),
++ 'Sparseseen with names: Dump()');
++ TEST (q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b), 6])),
++ 'Sparseseen with names: Dumpxs()')
++ if $XS;
++}
+
+
+ ############# 7
+@@ -147,8 +159,20 @@
+ EOT
+
+ $Data::Dumper::Purity = 1; # fill in the holes for eval
+-TEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a
+-TEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS;
++TEST (q(Data::Dumper->Dump([$a, $b], [qw(*a b)])),
++ 'Purity: basic test with dereferenced array: Dump()'); # print as @a
++TEST (q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])),
++ 'Purity: basic test with dereferenced array: Dumpxs()')
++ if $XS;
++
++SCOPE: {
++ local $Data::Dumper::Sparseseen = 1;
++ TEST (q(Data::Dumper->Dump([$a, $b], [qw(*a b)])),
++ 'Purity: Sparseseen with dereferenced array: Dump()'); # print as @a
++ TEST (q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])),
++ 'Purity: Sparseseen with dereferenced array: Dumpxs()')
++ if $XS;
++}
+
+ ############# 13
+ ##
+@@ -170,8 +194,11 @@
+ #$a = $b{'a'};
+ EOT
+
+-TEST q(Data::Dumper->Dump([$b, $a], [qw(*b a)])); # print as %b
+-TEST q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])) if $XS;
++TEST (q(Data::Dumper->Dump([$b, $a], [qw(*b a)])),
++ 'basic test with dereferenced hash: Dump()'); # print as %b
++TEST (q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])),
++ 'basic test with dereferenced hash: Dumpxs()')
++ if $XS;
+
+ ############# 19
+ ##
+@@ -193,17 +220,19 @@
+ EOT
+
+ $Data::Dumper::Indent = 1;
+-TEST q(
++TEST (q(
+ $d = Data::Dumper->new([$a,$b], [qw(a b)]);
+ $d->Seen({'*c' => $c});
+ $d->Dump;
+- );
++ ),
++ 'Indent: Seen: Dump()');
+ if ($XS) {
+- TEST q(
++ TEST (q(
+ $d = Data::Dumper->new([$a,$b], [qw(a b)]);
+ $d->Seen({'*c' => $c});
+ $d->Dumpxs;
+- );
++ ),
++ 'Indent: Seen: Dumpxs()');
+ }
+
+
+@@ -230,9 +259,12 @@
+
+ $d->Indent(3);
+ $d->Purity(0)->Quotekeys(0);
+-TEST q( $d->Reset; $d->Dump );
++TEST (q( $d->Reset; $d->Dump ),
++ 'Indent(3): Purity(0)->Quotekeys(0): Dump()');
+
+-TEST q( $d->Reset; $d->Dumpxs ) if $XS;
++TEST (q( $d->Reset; $d->Dumpxs ),
++ 'Indent(3): Purity(0)->Quotekeys(0): Dumpxs()')
++ if $XS;
+
+ ############# 31
+ ##
+@@ -253,8 +285,8 @@
+ #$VAR1->[2] = $VAR1->[1]{'c'};
+ EOT
+
+-TEST q(Dumper($a));
+-TEST q(Data::Dumper::DumperX($a)) if $XS;
++TEST (q(Dumper($a)), 'Dumper');
++TEST (q(Data::Dumper::DumperX($a)), 'DumperX') if $XS;
+
+ ############# 37
+ ##
+@@ -276,8 +308,11 @@
+ local $Data::Dumper::Purity = 0;
+ local $Data::Dumper::Quotekeys = 0;
+ local $Data::Dumper::Terse = 1;
+- TEST q(Dumper($a));
+- TEST q(Data::Dumper::DumperX($a)) if $XS;
++ TEST (q(Dumper($a)),
++ 'Purity 0: Quotekeys 0: Terse 1: Dumper');
++ TEST (q(Data::Dumper::DumperX($a)),
++ 'Purity 0: Quotekeys 0: Terse 1: DumperX')
++ if $XS;
+ }
+
+
+@@ -295,21 +330,10 @@
+ };
+ {
+ local $Data::Dumper::Useqq = 1;
+- TEST q(Dumper($foo));
++ TEST (q(Dumper($foo)), 'Useqq: Dumper');
++ TEST (q(Data::Dumper::DumperX($foo)), 'Useqq: DumperX') if $XS;
+ }
+
+- $WANT = <<"EOT";
+-#\$VAR1 = {
+-# 'abc\0\\'\efg' => 'mno\0',
+-# 'reftest' => \\\\1
+-#};
+-EOT
+-
+- {
+- local $Data::Dumper::Useqq = 1;
+- TEST q(Data::Dumper::DumperX($foo)) if $XS; # cheat
+- }
+-
+
+
+ #############
+@@ -353,8 +377,11 @@
+
+ $Data::Dumper::Purity = 1;
+ $Data::Dumper::Indent = 3;
+- TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
+- TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
++ TEST (q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])),
++ 'Purity 1: Indent 3: Dump()');
++ TEST (q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])),
++ 'Purity 1: Indent 3: Dumpxs()')
++ if $XS;
+
+ ############# 55
+ ##
+@@ -381,8 +408,11 @@
+ EOT
+
+ $Data::Dumper::Indent = 1;
+- TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
+- TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
++ TEST (q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])),
++ 'Purity 1: Indent 1: Dump()');
++ TEST (q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])),
++ 'Purity 1: Indent 1: Dumpxs()')
++ if $XS;
+
+ ############# 61
+ ##
+@@ -408,8 +438,11 @@
+ #$foo = $bar[1];
+ EOT
+
+- TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo']));
+- TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])) if $XS;
++ TEST (q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])),
++ 'array|hash|glob dereferenced: Dump()');
++ TEST (q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])),
++ 'array|hash|glob dereferenced: Dumpxs()')
++ if $XS;
+
+ ############# 67
+ ##
+@@ -435,8 +468,11 @@
+ #$foo = $bar->[1];
+ EOT
+
+- TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo']));
+- TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])) if $XS;
++ TEST (q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])),
++ 'array|hash|glob: not dereferenced: Dump()');
++ TEST (q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])),
++ 'array|hash|glob: not dereferenced: Dumpxs()')
++ if $XS;
+
+ ############# 73
+ ##
+@@ -457,8 +493,11 @@
+
+ $Data::Dumper::Purity = 0;
+ $Data::Dumper::Quotekeys = 0;
+- TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
+- TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
++ TEST (q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])),
++ 'Purity 0: Quotekeys 0: dereferenced: Dump()');
++ TEST (q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])),
++ 'Purity 0: Quotekeys 0: dereferenced: Dumpxs')
++ if $XS;
+
+ ############# 79
+ ##
+@@ -477,8 +516,11 @@
+ #$baz = $bar->[2];
+ EOT
+
+- TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
+- TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
++ TEST (q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])),
++ 'Purity 0: Quotekeys 0: not dereferenced: Dump()');
++ TEST (q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])),
++ 'Purity 0: Quotekeys 0: not dereferenced: Dumpxs()')
++ if $XS;
+
+ }
+
+@@ -494,7 +536,7 @@
+ $dogs[2] = \%kennel;
+ $mutts = \%kennel;
+ $mutts = $mutts; # avoid warning
+-
++
+ ############# 85
+ ##
+ $WANT = <<'EOT';
+@@ -510,19 +552,21 @@
+ #%mutts = %kennels;
+ EOT
+
+- TEST q(
++ TEST (q(
+ $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
+ [qw(*kennels *dogs *mutts)] );
+ $d->Dump;
+- );
++ ),
++ 'constructor: hash|array|scalar: Dump()');
+ if ($XS) {
+- TEST q(
++ TEST (q(
+ $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
+ [qw(*kennels *dogs *mutts)] );
+ $d->Dumpxs;
+- );
++ ),
++ 'constructor: hash|array|scalar: Dumpxs()');
+ }
+-
++
+ ############# 91
+ ##
+ $WANT = <<'EOT';
+@@ -531,9 +575,9 @@
+ #%mutts = %kennels;
+ EOT
+
+- TEST q($d->Dump);
+- TEST q($d->Dumpxs) if $XS;
+-
++ TEST q($d->Dump), 'object call: Dump';
++ TEST q($d->Dumpxs), 'object call: Dumpxs' if $XS;
++
+ ############# 97
+ ##
+ $WANT = <<'EOT';
+@@ -549,10 +593,9 @@
+ #%mutts = %kennels;
+ EOT
+
+-
+- TEST q($d->Reset; $d->Dump);
++ TEST q($d->Reset; $d->Dump), 'Reset and Dump separate calls';
+ if ($XS) {
+- TEST q($d->Reset; $d->Dumpxs);
++ TEST (q($d->Reset; $d->Dumpxs), 'Reset and Dumpxs separate calls');
+ }
+
+ ############# 103
+@@ -570,24 +613,26 @@
+ #%mutts = %{$dogs[2]};
+ EOT
+
+- TEST q(
++ TEST (q(
+ $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
+ [qw(*dogs *kennels *mutts)] );
+ $d->Dump;
+- );
++ ),
++ 'constructor: array|hash|scalar: Dump()');
+ if ($XS) {
+- TEST q(
++ TEST (q(
+ $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
+ [qw(*dogs *kennels *mutts)] );
+ $d->Dumpxs;
+- );
++ ),
++ 'constructor: array|hash|scalar: Dumpxs()');
+ }
+-
++
+ ############# 109
+ ##
+- TEST q($d->Reset->Dump);
++ TEST q($d->Reset->Dump), 'Reset Dump chained';
+ if ($XS) {
+- TEST q($d->Reset->Dumpxs);
++ TEST q($d->Reset->Dumpxs), 'Reset Dumpxs chained';
+ }
+
+ ############# 115
+@@ -607,14 +652,20 @@
+ #);
+ EOT
+
+- TEST q(
++ TEST (q(
+ $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] );
+ $d->Deepcopy(1)->Dump;
+- );
++ ),
++ 'Deepcopy(1): Dump');
+ if ($XS) {
+- TEST q($d->Reset->Dumpxs);
++# TEST 'q($d->Reset->Dumpxs);
++ TEST (q(
++ $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] );
++ $d->Deepcopy(1)->Dumpxs;
++ ),
++ 'Deepcopy(1): Dumpxs');
+ }
+-
++
+ }
+
+ {
+@@ -631,8 +682,10 @@
+ #];
+ EOT
+
+-TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dump;);
+-TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dumpxs;)
++TEST (q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dump;),
++ 'Seen: scalar: Dump');
++TEST (q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dumpxs;),
++ 'Seen: scalar: Dumpxs')
+ if $XS;
+
+ ############# 127
+@@ -644,8 +697,10 @@
+ #];
+ EOT
+
+-TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dump;);
+-TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dumpxs;)
++TEST (q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dump;),
++ 'Seen: glob: Dump');
++TEST (q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dumpxs;),
++ 'Seen: glob: Dumpxs')
+ if $XS;
+
+ ############# 133
+@@ -657,8 +712,11 @@
+ #);
+ EOT
+
+-TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dump;);
+-TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dumpxs;)
++TEST (q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dump;),
++ 'Seen: glob: dereference: Dump');
++TEST (q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' =>
++\&z})->Dumpxs;),
++ 'Seen: glob: derference: Dumpxs')
+ if $XS;
+
+ }
+@@ -677,8 +735,10 @@
+ #$a[1] = \$a[0];
+ EOT
+
+-TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dump;);
+-TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dumpxs;)
++TEST (q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dump;),
++ 'Purity(1): dereference: Dump');
++TEST (q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dumpxs;),
++ 'Purity(1): dereference: Dumpxs')
+ if $XS;
+ }
+
+@@ -693,8 +753,10 @@
+ #$b = ${${$a}};
+ EOT
+
+-TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
+-TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
++TEST (q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;),
++ 'Purity(1): not dereferenced: Dump');
++TEST (q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;),
++ 'Purity(1): not dereferenced: Dumpxs')
+ if $XS;
+ }
+
+@@ -725,8 +787,10 @@
+ #$b = ${$a->[0]{a}};
+ EOT
+
+-TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
+-TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
++TEST (q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;),
++ 'Purity(1): Dump again');
++TEST (q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;),
++ 'Purity(1); Dumpxs again')
+ if $XS;
+ }
+
+@@ -751,8 +815,10 @@
+ #$c = ${${$a->[0][0][0][0]}};
+ EOT
+
+-TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;);
+-TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;)
++TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;),
++ 'Purity(1): Dump: 3 elements');
++TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;),
++ 'Purity(1): Dumpxs: 3 elements')
+ if $XS;
+ }
+
+@@ -780,8 +846,10 @@
+ #$c = $a->{b}{c};
+ EOT
+
+-TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dump;);
+-TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dumpxs;)
++TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dump;),
++ 'Maxdepth(4): Dump()');
++TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dumpxs;),
++ 'Maxdepth(4): Dumpxs()')
+ if $XS;
+
+ ############# 169
+@@ -796,8 +864,10 @@
+ #];
+ EOT
+
+-TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dump;);
+-TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dumpxs;)
++TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dump;),
++ 'Maxdepth(1): Dump()');
++TEST (q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dumpxs;),
++ 'Maxdepth(1): Dumpxs()')
+ if $XS;
+ }
+
+@@ -813,8 +883,10 @@
+ #];
+ EOT
+
+-TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dump;);
+-TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dumpxs;)
++TEST (q(Data::Dumper->new([$b],['b'])->Purity(0)->Dump;),
++ 'Purity(0): Dump()');
++TEST (q(Data::Dumper->new([$b],['b'])->Purity(0)->Dumpxs;),
++ 'Purity(0): Dumpxs()')
+ if $XS;
+
+ ############# 181
+@@ -827,8 +899,10 @@
+ EOT
+
+
+-TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dump;);
+-TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dumpxs;)
++TEST (q(Data::Dumper->new([$b],['b'])->Purity(1)->Dump;),
++ 'Purity(1): Dump()');
++TEST (q(Data::Dumper->new([$b],['b'])->Purity(1)->Dumpxs;),
++ 'Purity(1): Dumpxs')
+ if $XS;
+ }
+
+@@ -869,8 +943,10 @@
+ #};
+ EOT
+
+-TEST q(Data::Dumper->new([$a])->Dump;);
+-TEST q(Data::Dumper->new([$a])->Dumpxs;)
++TEST (q(Data::Dumper->new([$a])->Dump;),
++ 'basic test without names: Dump()');
++TEST (q(Data::Dumper->new([$a])->Dumpxs;),
++ 'basic test without names: Dumpxs()')
+ if $XS;
+ }
+
+@@ -899,11 +975,8 @@
+ #};
+ EOT
+
+-# perl code does keys and values as numbers if possible
+-TEST q(Data::Dumper->new([$c])->Dump;);
+-# XS code always does them as strings
+-$WANT =~ s/ (\d+)/ '$1'/gs;
+-TEST q(Data::Dumper->new([$c])->Dumpxs;)
++TEST q(Data::Dumper->new([$c])->Dump;), "sortkeys sub";
++TEST q(Data::Dumper->new([$c])->Dumpxs;), "sortkeys sub (XS)"
+ if $XS;
+ }
+
+@@ -914,7 +987,7 @@
+ local $Data::Dumper::Sortkeys = \&sort205;
+ sub sort205 {
+ my $hash = shift;
+- return [
++ return [
+ $hash eq $c ? (sort { $a <=> $b } keys %$hash)
+ : (reverse sort keys %$hash)
+ ];
+@@ -949,9 +1022,10 @@
+ #];
+ EOT
+
+-TEST q(Data::Dumper->new([[$c, $d]])->Dump;);
+-$WANT =~ s/ (\d+)/ '$1'/gs;
+-TEST q(Data::Dumper->new([[$c, $d]])->Dumpxs;)
++TEST q(Data::Dumper->new([[$c, $d]])->Dump;), "more sortkeys sub";
++# the XS code does number values as strings
++$WANT =~ s/ (\d+)(,?)$/ '$1'$2/gm;
++TEST q(Data::Dumper->new([[$c, $d]])->Dumpxs;), "more sortkeys sub (XS)"
+ if $XS;
+ }
+
+@@ -972,7 +1046,8 @@
+ if(" $Config{'extensions'} " !~ m[ B ]) {
+ SKIP_TEST "Perl configured without B module";
+ } else {
+- TEST q(Data::Dumper->new([{ foo => sub { print "foo"; } }])->Dump);
++ TEST (q(Data::Dumper->new([{ foo => sub { print "foo"; } }])->Dump),
++ 'Deparse 1: Indent 2; Dump()');
+ }
+ }
+
+@@ -1387,8 +1462,11 @@
+ %ping = (chr (0xDECAF) x 4 =>\$ping);
+ for $Data::Dumper::Sortkeys (0, 1) {
+ if($] >= 5.007) {
+- TEST q(Data::Dumper->Dump([\\*ping, \\%ping], ['*ping', '*pong']));
+- TEST q(Data::Dumper->Dumpxs([\\*ping, \\%ping], ['*ping', '*pong'])) if $XS;
++ TEST (q(Data::Dumper->Dump([\\*ping, \\%ping], ['*ping', '*pong'])),
++ "utf8: Purity 1: Sortkeys: Dump()");
++ TEST (q(Data::Dumper->Dumpxs([\\*ping, \\%ping], ['*ping', '*pong'])),
++ "utf8: Purity 1: Sortkeys: Dumpxs()")
++ if $XS;
+ } else {
+ SKIP_TEST "Incomplete support for UTF-8 in old perls";
+ SKIP_TEST "Incomplete support for UTF-8 in old perls";
+@@ -1425,8 +1503,183 @@
+ EOT
+ @foo = ();
+ $foo[2] = 1;
+- TEST q(Data::Dumper->Dump([\@foo])), 'Richard Clamp, Message-Id: <[email protected]>';
+- TEST q(Data::Dumper->Dumpxs([\@foo])) if $XS;
++ TEST q(Data::Dumper->Dump([\@foo])), 'Richard Clamp, Message-Id: <[email protected]>: Dump()';
++ TEST q(Data::Dumper->Dumpxs([\@foo])), 'Richard Clamp, Message-Id: <[email protected]>: Dumpxs()'if $XS;
+ }
+
++############# 364
++# Make sure $obj->Dumpxs returns the right thing in list context. This was
++# broken by the initial attempt to fix [perl #74170].
++$WANT = <<'EOT';
++#$VAR1 = [];
++EOT
++TEST q(join " ", new Data::Dumper [[]],[] =>->Dumpxs),
++ '$obj->Dumpxs in list context'
++ if $XS;
++
++############# 366
++{
++ $WANT = <<'EOT';
++#$VAR1 = [
++# "\0\1\2\3\4\5\6\a\b\t\n\13\f\r\16\17\20\21\22\23\24\25\26\27\30\31\32\e\34\35\36\37 !\"#\$%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\177\200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237\240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257\260\261\262\263\264\265\266\267\270\271\272\273\274\275\276\277\300\301\302\303\304\305\306\307\310\311\312\313\314\315\316\317\320\321\322\323\324\325\326\327\330\331\332\333\334\335\336\337\340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357\360\361\362\363\364\365\366\367\370\371\372\373\374\375\376\377"
++#];
++EOT
+
++ $foo = [ join "", map chr, 0..255 ];
++ local $Data::Dumper::Useqq = 1;
++ TEST (q(Dumper($foo)), 'All latin1 characters: Dumper');
++ TEST (q(Data::Dumper::DumperX($foo)), 'All latin1 characters: DumperX') if $XS;
++}
++
++############# 372
++{
++ $WANT = <<'EOT';
++#$VAR1 = [
++# "\0\1\2\3\4\5\6\a\b\t\n\13\f\r\16\17\20\21\22\23\24\25\26\27\30\31\32\e\34\35\36\37 !\"#\$%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\177\x{80}\x{81}\x{82}\x{83}\x{84}\x{85}\x{86}\x{87}\x{88}\x{89}\x{8a}\x{8b}\x{8c}\x{8d}\x{8e}\x{8f}\x{90}\x{91}\x{92}\x{93}\x{94}\x{95}\x{96}\x{97}\x{98}\x{99}\x{9a}\x{9b}\x{9c}\x{9d}\x{9e}\x{9f}\x{a0}\x{a1}\x{a2}\x{a3}\x{a4}\x{a5}\x{a6}\x{a7}\x{a8}\x{a9}\x{aa}\x{ab}\x{ac}\x{ad}\x{ae}\x{af}\x{b0}\x{b1}\x{b2}\x{b3}\x{b4}\x{b5}\x{b6}\x{b7}\x{b8}\x{b9}\x{ba}\x{bb}\x{bc}\x{bd}\x{be}\x{bf}\x{c0}\x{c1}\x{c2}\x{c3}\x{c4}\x{c5}\x{c6}\x{c7}\x{c8}\x{c9}\x{ca}\x{cb}\x{cc}\x{cd}\x{ce}\x{cf}\x{d0}\x{d1}\x{d2}\x{d3}\x{d4}\x{d5}\x{d6}\x{d7}\x{d8}\x{d9}\x{da}\x{db}\x{dc}\x{dd}\x{de}\x{df}\x{e0}\x{e1}\x{e2}\x{e3}\x{e4}\x{e5}\x{e6}\x{e7}\x{e8}\x{e9}\x{ea}\x{eb}\x{ec}\x{ed}\x{ee}\x{ef}\x{f0}\x{f1}\x{f2}\x{f3}\x{f4}\x{f5}\x{f6}\x{f7}\x{f8}\x{f9}\x{fa}\x{fb}\x{fc}\x{fd}\x{fe}\x{ff}\x{20ac}"
++#];
++EOT
++
++ $foo = [ join "", map chr, 0..255, 0x20ac ];
++ local $Data::Dumper::Useqq = 1;
++ if ($] < 5.007) {
++ print "not ok " . (++$TNUM) . " # TODO - fails under 5.6\n" for 1..3;
++ }
++ else {
++ TEST q(Dumper($foo)),
++ 'All latin1 characters with utf8 flag including a wide character: Dumper';
++ }
++ TEST (q(Data::Dumper::DumperX($foo)),
++ 'All latin1 characters with utf8 flag including a wide character: DumperX')
++ if $XS;
++}
++
++############# 378
++{
++ # If XS cannot load, the pure-Perl version cannot deparse vstrings with
++ # underscores properly. In 5.8.0, vstrings are just strings.
++ my $no_vstrings = <<'NOVSTRINGS';
++#$a = \'ABC';
++#$b = \'ABC';
++#$c = \'ABC';
++#$d = \'ABC';
++NOVSTRINGS
++ my $vstrings_corr = <<'VSTRINGS_CORRECT';
++#$a = \v65.66.67;
++#$b = \v65.66.067;
++#$c = \v65.66.6_7;
++#$d = \'ABC';
++VSTRINGS_CORRECT
++ $WANT = $] <= 5.0080001
++ ? $no_vstrings
++ : $vstrings_corr;
++
++ @::_v = (
++ \v65.66.67,
++ \($] < 5.007 ? v65.66.67 : eval 'v65.66.067'),
++ \v65.66.6_7,
++ \~v190.189.188
++ );
++ if ($] >= 5.010) {
++ TEST q(Data::Dumper->Dump(\@::_v, [qw(a b c d)])), 'vstrings';
++ TEST q(Data::Dumper->Dumpxs(\@::_v, [qw(a b c d)])), 'xs vstrings'
++ if $XS;
++ }
++ else { # Skip tests before 5.10. vstrings considered funny before
++ SKIP_TEST "vstrings considered funny before 5.10.0";
++ SKIP_TEST "vstrings considered funny before 5.10.0 (XS)"
++ if $XS;
++ }
++}
++
++############# 384
++{
++ # [perl #107372] blessed overloaded globs
++ $WANT = <<'EOW';
++#$VAR1 = bless( \*::finkle, 'overtest' );
++EOW
++ {
++ package overtest;
++ use overload fallback=>1, q\""\=>sub{"oaoaa"};
++ }
++ TEST q(Data::Dumper->Dump([bless \*finkle, "overtest"])),
++ 'blessed overloaded globs';
++ TEST q(Data::Dumper->Dumpxs([\*finkle])), 'blessed overloaded globs (xs)'
++ if $XS;
++}
++############# 390
++{
++ # [perl #74798] uncovered behaviour
++ $WANT = <<'EOW';
++#$VAR1 = "\0000";
++EOW
++ local $Data::Dumper::Useqq = 1;
++ TEST q(Data::Dumper->Dump(["\x000"])),
++ "\\ octal followed by digit";
++ TEST q(Data::Dumper->Dumpxs(["\x000"])), '\\ octal followed by digit (xs)'
++ if $XS;
++
++ $WANT = <<'EOW';
++#$VAR1 = "\x{100}\0000";
++EOW
++ local $Data::Dumper::Useqq = 1;
++ TEST q(Data::Dumper->Dump(["\x{100}\x000"])),
++ "\\ octal followed by digit unicode";
++ TEST q(Data::Dumper->Dumpxs(["\x{100}\x000"])), '\\ octal followed by digit unicode (xs)'
++ if $XS;
++
++
++ $WANT = <<'EOW';
++#$VAR1 = "\0\x{660}";
++EOW
++ TEST q(Data::Dumper->Dump(["\\x00\\x{0660}"])),
++ "\\ octal followed by unicode digit";
++ TEST q(Data::Dumper->Dumpxs(["\\x00\\x{0660}"])), '\\ octal followed by unicode digit (xs)'
++ if $XS;
++
++ # [perl #118933 - handling of digits
++$WANT = <<'EOW';
++#$VAR1 = 0;
++#$VAR2 = 1;
++#$VAR3 = 90;
++#$VAR4 = -10;
++#$VAR5 = "010";
++#$VAR6 = 112345678;
++#$VAR7 = "1234567890";
++EOW
++ TEST q(Data::Dumper->Dump([0, 1, 90, -10, "010", "112345678", "1234567890" ])),
++ "numbers and number-like scalars";
++
++ TEST q(Data::Dumper->Dumpxs([0, 1, 90, -10, "010", "112345678", "1234567890" ])),
++ "numbers and number-like scalars"
++ if $XS;
++}
++############# 426
++{
++ # [perl #82948]
++ # re::regexp_pattern was moved to universal.c in v5.10.0-252-g192c1e2
++ # and apparently backported to maint-5.10
++ $WANT = $] > 5.010 ? <<'NEW' : <<'OLD';
++#$VAR1 = qr/abc/;
++#$VAR2 = qr/abc/i;
++NEW
++#$VAR1 = qr/(?-xism:abc)/;
++#$VAR2 = qr/(?i-xsm:abc)/;
++OLD
++ TEST q(Data::Dumper->Dump([ qr/abc/, qr/abc/i ])), "qr//";
++ TEST q(Data::Dumper->Dumpxs([ qr/abc/, qr/abc/i ])), "qr// xs"
++ if $XS;
++}
++############# 432
++
++{
++ sub foo {}
++ $WANT = <<'EOW';
++#*a = sub { "DUMMY" };
++#$b = \&a;
++EOW
++
++ TEST q(Data::Dumper->new([ \&foo, \\&foo ], [ "*a", "b" ])->Dump), "name of code in *foo";
++ TEST q(Data::Dumper->new([ \&foo, \\&foo ], [ "*a", "b" ])->Dumpxs), "name of code in *foo xs"
++ if $XS;
++}
++############# 436
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/dumpperl.t perl-5.12.5_dumper/dist/Data-Dumper/t/dumpperl.t
+--- perl-5.12.5/dist/Data-Dumper/t/dumpperl.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/dumpperl.t 2014-10-09 15:06:36.179445704 -0400
+@@ -0,0 +1,144 @@
++#!./perl -w
++# t/dumpperl.t - test all branches of, and modes of triggering, Dumpperl()
++BEGIN {
++ if ($ENV{PERL_CORE}){
++ require Config; import Config;
++ no warnings 'once';
++ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
++ print "1..0 # Skip: Data::Dumper was not built\n";
++ exit 0;
++ }
++ }
++}
++
++use strict;
++use Carp;
++use Data::Dumper;
++use Test::More tests => 31;
++use lib qw( ./t/lib );
++use Testing qw( _dumptostr );
++
++$Data::Dumper::Indent=1;
++
++{
++ local $Data::Dumper::Useperl=1;
++ local $Data::Dumper::Useqq=0;
++ local $Data::Dumper::Deparse=0;
++ note('$Data::Dumper::Useperl => 1');
++ run_tests_for_pure_perl_implementations();
++}
++
++{
++ local $Data::Dumper::Useperl=0;
++ local $Data::Dumper::Useqq=1;
++ local $Data::Dumper::Deparse=0;
++ note('$Data::Dumper::Useqq => 1');
++ run_tests_for_pure_perl_implementations();
++}
++
++{
++ local $Data::Dumper::Useperl=0;
++ local $Data::Dumper::Useqq=0;
++ local $Data::Dumper::Deparse=1;
++ note('$Data::Dumper::Deparse => 1');
++ run_tests_for_pure_perl_implementations();
++}
++
++
++
++sub run_tests_for_pure_perl_implementations {
++
++ my ($a, $b, $obj);
++ my (@names);
++ my (@newnames, $objagain, %newnames);
++ my $dumpstr;
++ $a = 'alpha';
++ $b = 'beta';
++ my @c = ( qw| eta theta | );
++ my %d = ( iota => 'kappa' );
++
++ note('names not provided');
++ $obj = Data::Dumper->new([$a, $b]);
++ $dumpstr = _dumptostr($obj);
++ like($dumpstr,
++ qr/\$VAR1.+alpha.+\$VAR2.+beta/s,
++ "Dump: two strings"
++ );
++
++ $obj = Data::Dumper->new([$a, \@c]);
++ $dumpstr = _dumptostr($obj);
++ like($dumpstr,
++ qr/\$VAR1.+alpha.+\$VAR2.+\[.+eta.+theta.+\]/s,
++ "Dump: one string, one array ref"
++ );
++
++ $obj = Data::Dumper->new([$a, \%d]);
++ $dumpstr = _dumptostr($obj);
++ like($dumpstr,
++ qr/\$VAR1.+alpha.+\$VAR2.+\{.+iota.+kappa.+\}/s,
++ "Dump: one string, one hash ref"
++ );
++
++ $obj = Data::Dumper->new([$a, undef]);
++ $dumpstr = _dumptostr($obj);
++ like($dumpstr,
++ qr/\$VAR1.+alpha.+\$VAR2.+undef/s,
++ "Dump: one string, one undef"
++ );
++
++ note('names provided');
++
++ $obj = Data::Dumper->new([$a, $b], [ qw( a b ) ]);
++ $dumpstr = _dumptostr($obj);
++ like($dumpstr,
++ qr/\$a.+alpha.+\$b.+beta/s,
++ "Dump: names: two strings"
++ );
++
++ $obj = Data::Dumper->new([$a, \@c], [ qw( a *c ) ]);
++ $dumpstr = _dumptostr($obj);
++ like($dumpstr,
++ qr/\$a.+alpha.+\@c.+eta.+theta/s,
++ "Dump: names: one string, one array ref"
++ );
++
++ $obj = Data::Dumper->new([$a, \%d], [ qw( a *d ) ]);
++ $dumpstr = _dumptostr($obj);
++ like($dumpstr,
++ qr/\$a.+alpha.+\%d.+iota.+kappa/s,
++ "Dump: names: one string, one hash ref"
++ );
++
++ $obj = Data::Dumper->new([$a,undef], [qw(a *c)]);
++ $dumpstr = _dumptostr($obj);
++ like($dumpstr,
++ qr/\$a.+alpha.+\$c.+undef/s,
++ "Dump: names: one string, one undef"
++ );
++
++ $obj = Data::Dumper->new([$a, $b], [ 'a', '']);
++ $dumpstr = _dumptostr($obj);
++ like($dumpstr,
++ qr/\$a.+alpha.+\$.+beta/s,
++ "Dump: names: two strings: one name empty"
++ );
++
++ $obj = Data::Dumper->new([$a, $b], [ 'a', '$foo']);
++ $dumpstr = _dumptostr($obj);
++ no warnings 'uninitialized';
++ like($dumpstr,
++ qr/\$a.+alpha.+\$foo.+beta/s,
++ "Dump: names: two strings: one name start with '\$'"
++ );
++ use warnings;
++}
++
++{
++ my ($obj, $dumpstr, $realtype);
++ $obj = Data::Dumper->new([ {IO => *{$::{STDERR}}{IO}} ]);
++ $obj->Useperl(1);
++ eval { $dumpstr = _dumptostr($obj); };
++ $realtype = 'IO';
++ like($@, qr/Can't handle '$realtype' type/,
++ "Got expected error: pure-perl: Data-Dumper does not handle $realtype");
++}
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/freezer_useperl.t perl-5.12.5_dumper/dist/Data-Dumper/t/freezer_useperl.t
+--- perl-5.12.5/dist/Data-Dumper/t/freezer_useperl.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/freezer_useperl.t 2014-10-09 15:06:36.176584265 -0400
+@@ -0,0 +1,106 @@
++#!./perl -w
++#
++# test a few problems with the Freezer option, not a complete Freezer
++# test suite yet
++
++BEGIN {
++ require Config; import Config;
++ no warnings 'once';
++ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
++ print "1..0 # Skip: Data::Dumper was not built\n";
++ exit 0;
++ }
++}
++
++use strict;
++use Test::More tests => 7;
++use Data::Dumper;
++use lib qw( ./t/lib );
++use Testing qw( _dumptostr );
++
++local $Data::Dumper::Useperl = 1;
++
++{
++ local $Data::Dumper::Freezer = 'freeze';
++
++ # test for seg-fault bug when freeze() returns a non-ref
++ {
++ my $foo = Test1->new("foo");
++ my $dumped_foo = Dumper($foo);
++ ok($dumped_foo,
++ "Use of freezer sub which returns non-ref worked.");
++ like($dumped_foo, qr/frozed/,
++ "Dumped string has the key added by Freezer with useperl.");
++ like(join(" ", Dumper($foo)), qr/\A\$VAR1 = /,
++ "Dumped list doesn't begin with Freezer's return value with useperl");
++ }
++
++ # test for warning when an object does not have a freeze()
++ {
++ my $warned = 0;
++ local $SIG{__WARN__} = sub { $warned++ };
++ my $bar = Test2->new("bar");
++ my $dumped_bar = Dumper($bar);
++ is($warned, 0, "A missing freeze() shouldn't warn.");
++ }
++
++ # a freeze() which die()s should still trigger the warning
++ {
++ my $warned = 0;
++ local $SIG{__WARN__} = sub { $warned++; };
++ my $bar = Test3->new("bar");
++ my $dumped_bar = Dumper($bar);
++ is($warned, 1, "A freeze() which die()s should warn.");
++ }
++
++}
++
++{
++ my ($obj, %dumps);
++ my $foo = Test1->new("foo");
++
++ local $Data::Dumper::Freezer = '';
++ $obj = Data::Dumper->new( [ $foo ] );
++ $dumps{'ddfemptystr'} = _dumptostr($obj);
++
++ local $Data::Dumper::Freezer = undef;
++ $obj = Data::Dumper->new( [ $foo ] );
++ $dumps{'ddfundef'} = _dumptostr($obj);
++
++ is($dumps{'ddfundef'}, $dumps{'ddfemptystr'},
++ "\$Data::Dumper::Freezer same with empty string or undef");
++}
++
++{
++ my ($obj, %dumps);
++ my $foo = Test1->new("foo");
++
++ $obj = Data::Dumper->new( [ $foo ] );
++ $obj->Freezer('');
++ $dumps{'objemptystr'} = _dumptostr($obj);
++
++ $obj = Data::Dumper->new( [ $foo ] );
++ $obj->Freezer(undef);
++ $dumps{'objundef'} = _dumptostr($obj);
++
++ is($dumps{'objundef'}, $dumps{'objemptystr'},
++ "Freezer() same with empty string or undef");
++}
++
++
++# a package with a freeze() which returns a non-ref
++package Test1;
++sub new { bless({name => $_[1]}, $_[0]) }
++sub freeze {
++ my $self = shift;
++ $self->{frozed} = 1;
++}
++
++# a package without a freeze()
++package Test2;
++sub new { bless({name => $_[1]}, $_[0]) }
++
++# a package with a freeze() which dies
++package Test3;
++sub new { bless({name => $_[1]}, $_[0]) }
++sub freeze { die "freeze() is broken" }
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/freezer.t perl-5.12.5_dumper/dist/Data-Dumper/t/freezer.t
+--- perl-5.12.5/dist/Data-Dumper/t/freezer.t 2012-11-03 19:25:59.000000000 -0400
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/freezer.t 2014-10-09 15:06:36.179907539 -0400
+@@ -7,74 +7,104 @@
+ require Config; import Config;
+ no warnings 'once';
+ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
+- print "1..0 # Skip: Data::Dumper was not built\n";
+- exit 0;
++ print "1..0 # Skip: Data::Dumper was not built\n";
++ exit 0;
+ }
+ }
+
+ use strict;
+-use Test::More qw(no_plan);
++use Test::More tests => 8;
+ use Data::Dumper;
+-$Data::Dumper::Freezer = 'freeze';
++use lib qw( ./t/lib );
++use Testing qw( _dumptostr );
+
+-# test for seg-fault bug when freeze() returns a non-ref
+-my $foo = Test1->new("foo");
+-my $dumped_foo = Dumper($foo);
+-ok($dumped_foo,
+- "Use of freezer sub which returns non-ref worked.");
+-like($dumped_foo, qr/frozed/,
+- "Dumped string has the key added by Freezer.");
+-
+-# run the same tests with useperl. this always worked
+ {
+- local $Data::Dumper::Useperl = 1;
+- my $foo = Test1->new("foo");
+- my $dumped_foo = Dumper($foo);
+- ok($dumped_foo,
+- "Use of freezer sub which returns non-ref worked with useperl");
+- like($dumped_foo, qr/frozed/,
+- "Dumped string has the key added by Freezer with useperl.");
++ local $Data::Dumper::Freezer = 'freeze';
++
++ # test for seg-fault bug when freeze() returns a non-ref
++ {
++ my $foo = Test1->new("foo");
++ my $dumped_foo = Dumper($foo);
++ ok($dumped_foo,
++ "Use of freezer sub which returns non-ref worked.");
++ like($dumped_foo, qr/frozed/,
++ "Dumped string has the key added by Freezer with useperl.");
++ like(join(" ", Dumper($foo)), qr/\A\$VAR1 = /,
++ "Dumped list doesn't begin with Freezer's return value with useperl");
++ }
++
++
++ # test for warning when an object does not have a freeze()
++ {
++ my $warned = 0;
++ local $SIG{__WARN__} = sub { $warned++ };
++ my $bar = Test2->new("bar");
++ my $dumped_bar = Dumper($bar);
++ is($warned, 0, "A missing freeze() shouldn't warn.");
++ }
++
++
++ # a freeze() which die()s should still trigger the warning
++ {
++ my $warned = 0;
++ local $SIG{__WARN__} = sub { $warned++; };
++ my $bar = Test3->new("bar");
++ my $dumped_bar = Dumper($bar);
++ is($warned, 1, "A freeze() which die()s should warn.");
++ }
++
+ }
+
+-# test for warning when an object doesn't have a freeze()
+ {
+- my $warned = 0;
+- local $SIG{__WARN__} = sub { $warned++ };
+- my $bar = Test2->new("bar");
+- my $dumped_bar = Dumper($bar);
+- is($warned, 0, "A missing freeze() shouldn't warn.");
+-}
++ my ($obj, %dumps);
++ my $foo = Test1->new("foo");
+
++ local $Data::Dumper::Freezer = 'freeze';
++ $obj = Data::Dumper->new( [ $foo ] );
++ $dumps{'ddftrue'} = _dumptostr($obj);
++ local $Data::Dumper::Freezer = '';
++
++ $obj = Data::Dumper->new( [ $foo ] );
++ $obj->Freezer('freeze');
++ $dumps{'objset'} = _dumptostr($obj);
+
+-# run the same test with useperl, which always worked
+-{
+- local $Data::Dumper::Useperl = 1;
+- my $warned = 0;
+- local $SIG{__WARN__} = sub { $warned++ };
+- my $bar = Test2->new("bar");
+- my $dumped_bar = Dumper($bar);
+- is($warned, 0, "A missing freeze() shouldn't warn with useperl");
++ is($dumps{'ddftrue'}, $dumps{'objset'},
++ "\$Data::Dumper::Freezer and Freezer() are equivalent");
+ }
+
+-# a freeze() which die()s should still trigger the warning
+ {
+- my $warned = 0;
+- local $SIG{__WARN__} = sub { $warned++; };
+- my $bar = Test3->new("bar");
+- my $dumped_bar = Dumper($bar);
+- is($warned, 1, "A freeze() which die()s should warn.");
++ my ($obj, %dumps);
++ my $foo = Test1->new("foo");
++
++ local $Data::Dumper::Freezer = '';
++ $obj = Data::Dumper->new( [ $foo ] );
++ $dumps{'ddfemptystr'} = _dumptostr($obj);
++
++ local $Data::Dumper::Freezer = undef;
++ $obj = Data::Dumper->new( [ $foo ] );
++ $dumps{'ddfundef'} = _dumptostr($obj);
++
++ is($dumps{'ddfundef'}, $dumps{'ddfemptystr'},
++ "\$Data::Dumper::Freezer same with empty string or undef");
+ }
+
+-# the same should work in useperl
+ {
+- local $Data::Dumper::Useperl = 1;
+- my $warned = 0;
+- local $SIG{__WARN__} = sub { $warned++; };
+- my $bar = Test3->new("bar");
+- my $dumped_bar = Dumper($bar);
+- is($warned, 1, "A freeze() which die()s should warn with useperl.");
++ my ($obj, %dumps);
++ my $foo = Test1->new("foo");
++
++ $obj = Data::Dumper->new( [ $foo ] );
++ $obj->Freezer('');
++ $dumps{'objemptystr'} = _dumptostr($obj);
++
++ $obj = Data::Dumper->new( [ $foo ] );
++ $obj->Freezer(undef);
++ $dumps{'objundef'} = _dumptostr($obj);
++
++ is($dumps{'objundef'}, $dumps{'objemptystr'},
++ "Freezer() same with empty string or undef");
+ }
+
++
+ # a package with a freeze() which returns a non-ref
+ package Test1;
+ sub new { bless({name => $_[1]}, $_[0]) }
+@@ -90,4 +120,4 @@
+ # a package with a freeze() which dies
+ package Test3;
+ sub new { bless({name => $_[1]}, $_[0]) }
+-sub freeze { die "freeze() is broked" }
++sub freeze { die "freeze() is broken" }
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/indent.t perl-5.12.5_dumper/dist/Data-Dumper/t/indent.t
+--- perl-5.12.5/dist/Data-Dumper/t/indent.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/indent.t 2014-10-09 15:06:36.178235441 -0400
+@@ -0,0 +1,113 @@
++#!./perl -w
++# t/indent.t - Test Indent()
++BEGIN {
++ if ($ENV{PERL_CORE}){
++ require Config; import Config;
++ no warnings 'once';
++ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
++ print "1..0 # Skip: Data::Dumper was not built\n";
++ exit 0;
++ }
++ }
++}
++
++use strict;
++
++use Data::Dumper;
++use Test::More tests => 10;
++use lib qw( ./t/lib );
++use Testing qw( _dumptostr );
++
++
++my $hash = { foo => 42 };
++
++my (%dumpstr);
++my $dumper;
++
++$dumper = Data::Dumper->new([$hash]);
++$dumpstr{noindent} = _dumptostr($dumper);
++# $VAR1 = {
++# 'foo' => 42
++# };
++
++$dumper = Data::Dumper->new([$hash]);
++$dumper->Indent();
++$dumpstr{indent_no_arg} = _dumptostr($dumper);
++
++$dumper = Data::Dumper->new([$hash]);
++$dumper->Indent(undef);
++$dumpstr{indent_undef} = _dumptostr($dumper);
++
++$dumper = Data::Dumper->new([$hash]);
++$dumper->Indent(0);
++$dumpstr{indent_0} = _dumptostr($dumper);
++# $VAR1 = {'foo' => 42}; # no newline
++
++$dumper = Data::Dumper->new([$hash]);
++$dumper->Indent(1);
++$dumpstr{indent_1} = _dumptostr($dumper);
++# $VAR1 = {
++# 'foo' => 42
++# };
++
++$dumper = Data::Dumper->new([$hash]);
++$dumper->Indent(2);
++$dumpstr{indent_2} = _dumptostr($dumper);
++# $VAR1 = {
++# 'foo' => 42
++# };
++
++is($dumpstr{noindent}, $dumpstr{indent_no_arg},
++ "absence of Indent is same as Indent()");
++is($dumpstr{noindent}, $dumpstr{indent_undef},
++ "absence of Indent is same as Indent(undef)");
++isnt($dumpstr{noindent}, $dumpstr{indent_0},
++ "absence of Indent is different from Indent(0)");
++isnt($dumpstr{indent_0}, $dumpstr{indent_1},
++ "Indent(0) is different from Indent(1)");
++cmp_ok(length($dumpstr{indent_0}), '<=', length($dumpstr{indent_1}),
++ "Indent(0) is more compact than Indent(1)");
++is($dumpstr{noindent}, $dumpstr{indent_2},
++ "absence of Indent is same as Indent(2), i.e., 2 is default");
++cmp_ok(length($dumpstr{indent_1}), '<=', length($dumpstr{indent_2}),
++ "Indent(1) is more compact than Indent(2)");
++
++my $array = [ qw| foo 42 | ];
++$dumper = Data::Dumper->new([$array]);
++$dumper->Indent(2);
++$dumpstr{ar_indent_2} = _dumptostr($dumper);
++# $VAR1 = [
++# 'foo',
++# '42'
++# ];
++
++$dumper = Data::Dumper->new([$array]);
++$dumper->Indent(3);
++$dumpstr{ar_indent_3} = _dumptostr($dumper);
++# $VAR1 = [
++# #0
++# 'foo',
++# #1
++# '42'
++# ];
++
++isnt($dumpstr{ar_indent_2}, $dumpstr{ar_indent_3},
++ "On arrays, Indent(2) is different from Indent(3)");
++like($dumpstr{ar_indent_3},
++ qr/\#0.+'foo'.+\#1.+42/s,
++ "Indent(3) annotates array elements with their indices"
++);
++{
++ no if $] < 5.011, warnings => 'deprecated';
++ is(scalar(split("\n" => $dumpstr{ar_indent_2})) + 2,
++ scalar(split("\n" => $dumpstr{ar_indent_3})),
++ "Indent(3) runs 2 lines longer than Indent(2)");
++}
++
++__END__
++is($dumpstr{noindent}, $dumpstr{indent_0},
++ "absence of Indent is same as Indent(0)");
++isnt($dumpstr{noindent}, $dumpstr{indent_1},
++ "absence of Indent is different from Indent(1)");
++print STDERR $dumpstr{indent_0};
++print STDERR $dumpstr{ar_indent_3};
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/lib/Testing.pm perl-5.12.5_dumper/dist/Data-Dumper/t/lib/Testing.pm
+--- perl-5.12.5/dist/Data-Dumper/t/lib/Testing.pm 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/lib/Testing.pm 2014-10-09 15:06:36.173740795 -0400
+@@ -0,0 +1,15 @@
++package Testing;
++use 5.006_001;
++use strict;
++use warnings;
++require Exporter;
++our @ISA = qw(Exporter);
++our @EXPORT_OK = qw(_dumptostr);
++use Carp;
++
++sub _dumptostr {
++ my ($obj) = @_;
++ return join '', $obj->Dump;
++}
++
++1;
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/misc.t perl-5.12.5_dumper/dist/Data-Dumper/t/misc.t
+--- perl-5.12.5/dist/Data-Dumper/t/misc.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/misc.t 2014-10-09 15:06:36.174735741 -0400
+@@ -0,0 +1,209 @@
++#!./perl -w
++# t/misc.t - Test various functionality
++
++BEGIN {
++ if ($ENV{PERL_CORE}){
++ require Config; import Config;
++ no warnings 'once';
++ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
++ print "1..0 # Skip: Data::Dumper was not built\n";
++ exit 0;
++ }
++ }
++}
++
++use strict;
++
++use Data::Dumper;
++use Test::More tests => 20;
++use lib qw( ./t/lib );
++use Testing qw( _dumptostr );
++
++my ($a, $b, @c, %d);
++$a = 'alpha';
++$b = 'beta';
++@c = ( qw| gamma delta epsilon | );
++%d = ( zeta => 'eta', theta => 'iota' );
++
++note("Argument validation for new()");
++{
++ local $@ = '';
++ eval { my $obj = Data::Dumper->new(undef); };
++ like($@,
++ qr/^Usage:\s+PACKAGE->new\(ARRAYREF,\s*\[ARRAYREF\]\)/,
++ "Got error message: new() needs defined argument"
++ );
++}
++
++{
++ local $@ = '';
++ eval { my $obj = Data::Dumper->new( { $a => $b } ); };
++ like($@,
++ qr/^Usage:\s+PACKAGE->new\(ARRAYREF,\s*\[ARRAYREF\]\)/,
++ "Got error message: new() needs array reference"
++ );
++}
++
++{
++ note("\$Data::Dumper::Useperl, Useqq, Deparse");
++ my ($obj, %dumpstr);
++
++ local $Data::Dumper::Useperl = 1;
++ $obj = Data::Dumper->new( [ \@c, \%d ] );
++ $dumpstr{useperl} = [ $obj->Values ];
++ local $Data::Dumper::Useperl = 0;
++
++ local $Data::Dumper::Useqq = 1;
++ $obj = Data::Dumper->new( [ \@c, \%d ] );
++ $dumpstr{useqq} = [ $obj->Values ];
++ local $Data::Dumper::Useqq = 0;
++
++ is_deeply($dumpstr{useperl}, $dumpstr{useqq},
++ "Useperl and Useqq return same");
++
++ local $Data::Dumper::Deparse = 1;
++ $obj = Data::Dumper->new( [ \@c, \%d ] );
++ $dumpstr{deparse} = [ $obj->Values ];
++ local $Data::Dumper::Deparse = 0;
++
++ is_deeply($dumpstr{useperl}, $dumpstr{deparse},
++ "Useperl and Deparse return same");
++}
++
++{
++ note("\$Data::Dumper::Pad and \$obj->Pad");
++ my ($obj, %dumps, $pad);
++ $obj = Data::Dumper->new([$a,$b]);
++ $dumps{'noprev'} = _dumptostr($obj);
++
++ $obj = Data::Dumper->new([$a,$b]);
++ $obj->Pad(undef);
++ $dumps{'undef'} = _dumptostr($obj);
++
++ $obj = Data::Dumper->new([$a,$b]);
++ $obj->Pad('');
++ $dumps{'emptystring'} = _dumptostr($obj);
++
++ is($dumps{'noprev'}, $dumps{'undef'},
++ "No setting for \$Data::Dumper::Pad and Pad(undef) give same result");
++
++ is($dumps{'noprev'}, $dumps{'emptystring'},
++ "No setting for \$Data::Dumper::Pad and Pad('') give same result");
++
++ $pad = 'XXX: ';
++ local $Data::Dumper::Pad = $pad;
++ $obj = Data::Dumper->new([$a,$b]);
++ $dumps{'ddp'} = _dumptostr($obj);
++ local $Data::Dumper::Pad = '';
++
++ $obj = Data::Dumper->new([$a,$b]);
++ $obj->Pad($pad);
++ $dumps{'obj'} = _dumptostr($obj);
++
++ is($dumps{'ddp'}, $dumps{'obj'},
++ "\$Data::Dumper::Pad and \$obj->Pad() give same result");
++
++ is( (grep {! /^$pad/} (split(/\n/, $dumps{'ddp'}))), 0,
++ "Each line of dumped output padded as expected");
++}
++
++{
++ note("\$Data::Dumper::Varname and \$obj->Varname");
++ my ($obj, %dumps, $varname);
++ $obj = Data::Dumper->new([$a,$b]);
++ $dumps{'noprev'} = _dumptostr($obj);
++
++ $obj = Data::Dumper->new([$a,$b]);
++ $obj->Varname(undef);
++ $dumps{'undef'} = _dumptostr($obj);
++
++ $obj = Data::Dumper->new([$a,$b]);
++ $obj->Varname('');
++ $dumps{'emptystring'} = _dumptostr($obj);
++
++ is($dumps{'noprev'}, $dumps{'undef'},
++ "No setting for \$Data::Dumper::Varname and Varname(undef) give same result");
++
++ # Because Varname defaults to '$VAR', providing an empty argument to
++ # Varname produces a non-default result.
++ isnt($dumps{'noprev'}, $dumps{'emptystring'},
++ "No setting for \$Data::Dumper::Varname and Varname('') give different results");
++
++ $varname = 'MIMI';
++ local $Data::Dumper::Varname = $varname;
++ $obj = Data::Dumper->new([$a,$b]);
++ $dumps{'ddv'} = _dumptostr($obj);
++ local $Data::Dumper::Varname = undef;
++
++ $obj = Data::Dumper->new([$a,$b]);
++ $obj->Varname($varname);
++ $dumps{'varname'} = _dumptostr($obj);
++
++ is($dumps{'ddv'}, $dumps{'varname'},
++ "Setting for \$Data::Dumper::Varname and Varname() give same result");
++
++ is( (grep { /^\$$varname/ } (split(/\n/, $dumps{'ddv'}))), 2,
++ "All lines of dumped output use provided varname");
++
++ is( (grep { /^\$VAR/ } (split(/\n/, $dumps{'ddv'}))), 0,
++ "No lines of dumped output use default \$VAR");
++}
++
++{
++ note("\$Data::Dumper::Useqq and \$obj->Useqq");
++ my ($obj, %dumps, $useqq);
++ $obj = Data::Dumper->new([$a,$b]);
++ $dumps{'noprev'} = _dumptostr($obj);
++
++ $obj = Data::Dumper->new([$a,$b]);
++ $obj->Useqq(undef);
++ $dumps{'undef'} = _dumptostr($obj);
++
++ $obj = Data::Dumper->new([$a,$b]);
++ $obj->Useqq('');
++ $dumps{'emptystring'} = _dumptostr($obj);
++
++ $obj = Data::Dumper->new([$a,$b]);
++ $obj->Useqq(0);
++ $dumps{'zero'} = _dumptostr($obj);
++
++ my $current = $Data::Dumper::Useqq;
++ local $Data::Dumper::Useqq = 0;
++ $obj = Data::Dumper->new([$a,$b]);
++ $dumps{'dduzero'} = _dumptostr($obj);
++ local $Data::Dumper::Useqq = $current;
++
++ is($dumps{'noprev'}, $dumps{'undef'},
++ "No setting for \$Data::Dumper::Useqq and Useqq(undef) give same result");
++
++ is($dumps{'noprev'}, $dumps{'zero'},
++ "No setting for \$Data::Dumper::Useqq and Useqq(0) give same result");
++
++ is($dumps{'noprev'}, $dumps{'emptystring'},
++ "No setting for \$Data::Dumper::Useqq and Useqq('') give same result");
++
++ is($dumps{'noprev'}, $dumps{'dduzero'},
++ "No setting for \$Data::Dumper::Useqq and Useqq(undef) give same result");
++
++ local $Data::Dumper::Useqq = 1;
++ $obj = Data::Dumper->new([$a,$b]);
++ $dumps{'ddu'} = _dumptostr($obj);
++ local $Data::Dumper::Useqq = $current;
++
++ $obj = Data::Dumper->new([$a,$b]);
++ $obj->Useqq(1);
++ $dumps{'obj'} = _dumptostr($obj);
++
++ is($dumps{'ddu'}, $dumps{'obj'},
++ "\$Data::Dumper::Useqq=1 and Useqq(1) give same result");
++
++ like($dumps{'ddu'},
++ qr/"$a".+?"$b"/s,
++ "Double-quotes used around values"
++ );
++
++ unlike($dumps{'ddu'},
++ qr/'$a'.+?'$b'/s,
++ "Single-quotes not used around values"
++ );
++}
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/names.t perl-5.12.5_dumper/dist/Data-Dumper/t/names.t
+--- perl-5.12.5/dist/Data-Dumper/t/names.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/names.t 2014-10-09 15:06:36.178953190 -0400
+@@ -0,0 +1,66 @@
++#!./perl -w
++
++BEGIN {
++ if ($ENV{PERL_CORE}){
++ require Config; import Config;
++ no warnings 'once';
++ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
++ print "1..0 # Skip: Data::Dumper was not built\n";
++ exit 0;
++ }
++ }
++}
++
++use strict;
++use Carp;
++use Data::Dumper;
++use Test::More tests => 15;
++use lib qw( ./t/lib );
++use Testing qw( _dumptostr );
++
++my ($a, $b, $obj);
++my (@names);
++my (@newnames, $objagain, %newnames);
++my $dumpstr;
++$a = 'alpha';
++$b = 'beta';
++
++$obj = Data::Dumper->new([$a,$b], [qw(a b)]);
++@names = $obj->Names;
++is_deeply(\@names, [qw(a b)], "Names() returned expected list");
++
++@newnames = ( qw| gamma delta | );
++$objagain = $obj->Names(\@newnames);
++is($objagain, $obj, "Names returned same object");
++is_deeply($objagain->{names}, \@newnames,
++ "Able to use Names() to set names to be dumped");
++
++$obj = Data::Dumper->new([$a,$b], [qw(a b)]);
++%newnames = ( gamma => 'delta', epsilon => 'zeta' );
++eval { @names = $obj->Names(\%newnames); };
++like($@, qr/Argument to Names, if provided, must be array ref/,
++ "Got expected error message: bad argument to Names()");
++
++$obj = Data::Dumper->new([$a,$b], [qw(a b)]);
++@newnames = ( qw| gamma delta epsilon | );
++$objagain = $obj->Names(\@newnames);
++is($objagain, $obj, "Names returned same object");
++is_deeply($objagain->{names}, \@newnames,
++ "Able to use Names() to set names to be dumped");
++$dumpstr = _dumptostr($obj);
++like($dumpstr, qr/gamma/s, "Got first name expected");
++like($dumpstr, qr/delta/s, "Got first name expected");
++unlike($dumpstr, qr/epsilon/s, "Did not get name which was not expected");
++
++$obj = Data::Dumper->new([$a,$b], [qw(a b)]);
++@newnames = ( qw| gamma | );
++$objagain = $obj->Names(\@newnames);
++is($objagain, $obj, "Names returned same object");
++is_deeply($objagain->{names}, \@newnames,
++ "Able to use Names() to set names to be dumped");
++$dumpstr = _dumptostr($obj);
++like($dumpstr, qr/gamma/s, "Got name expected");
++unlike($dumpstr, qr/delta/s, "Did not get name which was not expected");
++unlike($dumpstr, qr/epsilon/s, "Did not get name which was not expected");
++like($dumpstr, qr/\$VAR2/s, "Got default name");
++
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/overload.t perl-5.12.5_dumper/dist/Data-Dumper/t/overload.t
+--- perl-5.12.5/dist/Data-Dumper/t/overload.t 2012-11-03 19:25:59.000000000 -0400
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/overload.t 2014-10-09 15:06:36.177778379 -0400
+@@ -11,9 +11,10 @@
+ }
+ }
+
++use strict;
+ use Data::Dumper;
+
+-print "1..1\n";
++use Test::More tests => 4;
+
+ package Foo;
+ use overload '""' => 'as_string';
+@@ -25,12 +26,11 @@
+
+ my $f = Foo->new;
+
+-print "#\$f=$f\n";
++isa_ok($f, 'Foo');
++is("$f", '%%%%', 'String overloading works');
+
+-$_ = Dumper($f);
+-s/^/#/mg;
+-print $_;
++my $d = Dumper($f);
+
+-print "not " unless /bar/ && /Foo/;
+-print "ok 1\n";
++like($d, qr/bar/);
++like($d, qr/Foo/);
+
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/perl-74170.t perl-5.12.5_dumper/dist/Data-Dumper/t/perl-74170.t
+--- perl-5.12.5/dist/Data-Dumper/t/perl-74170.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/perl-74170.t 2014-10-09 15:06:36.177564131 -0400
+@@ -0,0 +1,145 @@
++#!perl -X
++#
++# Regression test for [perl #74170] (missing SPAGAIN after DD_Dump(...)):
++# Since it’s so large, it gets its own file.
++
++BEGIN {
++ if ($ENV{PERL_CORE}){
++ require Config; import Config;
++ no warnings 'once';
++ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
++ print "1..0 # Skip: Data::Dumper was not built\n";
++ exit 0;
++ }
++ }
++}
++use strict;
++use Test::More tests => 1;
++use Data::Dumper;
++
++our %repos = real_life_setup();
++
++$Data::Dumper::Indent = 1;
++# A custom sort sub is necessary for reproducing the bug, as this is where
++# the stack gets reallocated.
++$Data::Dumper::Sortkeys = sub { return [ reverse sort keys %{$_[0]} ]; }
++ unless exists $ENV{NO_SORT_SUB};
++
++ok(Data::Dumper->Dump([\%repos], [qw(*repos)]), "RT 74170 test");
++
++sub real_life_setup {
++ # set up the %repos hash in a manner that reflects a real run of
++ # the gitolite "compiler" script:
++ # Yes, all this is necessary to get the stack in such a state that the
++ # custom sort sub will trigger a reallocation.
++ my %repos;
++ push @{ $repos{''}{'@all'} }, ();
++ push @{ $repos{''}{'guser86'} }, ();
++ push @{ $repos{''}{'guser87'} }, ();
++ push @{ $repos{''}{'user88'} }, ();
++ push @{ $repos{''}{'grussell'} }, ();
++ push @{ $repos{''}{'guser0'} }, ();
++ push @{ $repos{''}{'guser1'} }, ();
++ push @{ $repos{''}{'guser10'} }, ();
++ push @{ $repos{''}{'guser11'} }, ();
++ push @{ $repos{''}{'guser12'} }, ();
++ push @{ $repos{''}{'guser13'} }, ();
++ push @{ $repos{''}{'guser14'} }, ();
++ push @{ $repos{''}{'guser15'} }, ();
++ push @{ $repos{''}{'guser16'} }, ();
++ push @{ $repos{''}{'guser17'} }, ();
++ push @{ $repos{''}{'guser18'} }, ();
++ push @{ $repos{''}{'guser19'} }, ();
++ push @{ $repos{''}{'guser2'} }, ();
++ push @{ $repos{''}{'guser20'} }, ();
++ push @{ $repos{''}{'guser21'} }, ();
++ push @{ $repos{''}{'guser22'} }, ();
++ push @{ $repos{''}{'guser23'} }, ();
++ push @{ $repos{''}{'guser24'} }, ();
++ push @{ $repos{''}{'guser25'} }, ();
++ push @{ $repos{''}{'guser26'} }, ();
++ push @{ $repos{''}{'guser27'} }, ();
++ push @{ $repos{''}{'guser28'} }, ();
++ push @{ $repos{''}{'guser29'} }, ();
++ push @{ $repos{''}{'guser3'} }, ();
++ push @{ $repos{''}{'guser30'} }, ();
++ push @{ $repos{''}{'guser31'} }, ();
++ push @{ $repos{''}{'guser32'} }, ();
++ push @{ $repos{''}{'guser33'} }, ();
++ push @{ $repos{''}{'guser34'} }, ();
++ push @{ $repos{''}{'guser35'} }, ();
++ push @{ $repos{''}{'guser36'} }, ();
++ push @{ $repos{''}{'guser37'} }, ();
++ push @{ $repos{''}{'guser38'} }, ();
++ push @{ $repos{''}{'guser39'} }, ();
++ push @{ $repos{''}{'guser4'} }, ();
++ push @{ $repos{''}{'guser40'} }, ();
++ push @{ $repos{''}{'guser41'} }, ();
++ push @{ $repos{''}{'guser42'} }, ();
++ push @{ $repos{''}{'guser43'} }, ();
++ push @{ $repos{''}{'guser44'} }, ();
++ push @{ $repos{''}{'guser45'} }, ();
++ push @{ $repos{''}{'guser46'} }, ();
++ push @{ $repos{''}{'guser47'} }, ();
++ push @{ $repos{''}{'guser48'} }, ();
++ push @{ $repos{''}{'guser49'} }, ();
++ push @{ $repos{''}{'guser5'} }, ();
++ push @{ $repos{''}{'guser50'} }, ();
++ push @{ $repos{''}{'guser51'} }, ();
++ push @{ $repos{''}{'guser52'} }, ();
++ push @{ $repos{''}{'guser53'} }, ();
++ push @{ $repos{''}{'guser54'} }, ();
++ push @{ $repos{''}{'guser55'} }, ();
++ push @{ $repos{''}{'guser56'} }, ();
++ push @{ $repos{''}{'guser57'} }, ();
++ push @{ $repos{''}{'guser58'} }, ();
++ push @{ $repos{''}{'guser59'} }, ();
++ push @{ $repos{''}{'guser6'} }, ();
++ push @{ $repos{''}{'guser60'} }, ();
++ push @{ $repos{''}{'guser61'} }, ();
++ push @{ $repos{''}{'guser62'} }, ();
++ push @{ $repos{''}{'guser63'} }, ();
++ push @{ $repos{''}{'guser64'} }, ();
++ push @{ $repos{''}{'guser65'} }, ();
++ push @{ $repos{''}{'guser66'} }, ();
++ push @{ $repos{''}{'guser67'} }, ();
++ push @{ $repos{''}{'guser68'} }, ();
++ push @{ $repos{''}{'guser69'} }, ();
++ push @{ $repos{''}{'guser7'} }, ();
++ push @{ $repos{''}{'guser70'} }, ();
++ push @{ $repos{''}{'guser71'} }, ();
++ push @{ $repos{''}{'guser72'} }, ();
++ push @{ $repos{''}{'guser73'} }, ();
++ push @{ $repos{''}{'guser74'} }, ();
++ push @{ $repos{''}{'guser75'} }, ();
++ push @{ $repos{''}{'guser76'} }, ();
++ push @{ $repos{''}{'guser77'} }, ();
++ push @{ $repos{''}{'guser78'} }, ();
++ push @{ $repos{''}{'guser79'} }, ();
++ push @{ $repos{''}{'guser8'} }, ();
++ push @{ $repos{''}{'guser80'} }, ();
++ push @{ $repos{''}{'guser81'} }, ();
++ push @{ $repos{''}{'guser82'} }, ();
++ push @{ $repos{''}{'guser83'} }, ();
++ push @{ $repos{''}{'guser84'} }, ();
++ push @{ $repos{''}{'guser85'} }, ();
++ push @{ $repos{''}{'guser9'} }, ();
++ push @{ $repos{''}{'user1'} }, ();
++ push @{ $repos{''}{'user10'} }, ();
++ push @{ $repos{''}{'user11'} }, ();
++ push @{ $repos{''}{'user12'} }, ();
++ push @{ $repos{''}{'user13'} }, ();
++ push @{ $repos{''}{'user14'} }, ();
++ push @{ $repos{''}{'user15'} }, ();
++ push @{ $repos{''}{'user16'} }, ();
++ push @{ $repos{''}{'user2'} }, ();
++ push @{ $repos{''}{'user3'} }, ();
++ push @{ $repos{''}{'user4'} }, ();
++ push @{ $repos{''}{'user5'} }, ();
++ push @{ $repos{''}{'user6'} }, ();
++ push @{ $repos{''}{'user7'} }, ();
++ $repos{''}{R}{'user8'} = 1;
++ $repos{''}{W}{'user8'} = 1;
++ push @{ $repos{''}{'user8'} }, ();
++ return %repos;
++}
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/purity_deepcopy_maxdepth.t perl-5.12.5_dumper/dist/Data-Dumper/t/purity_deepcopy_maxdepth.t
+--- perl-5.12.5/dist/Data-Dumper/t/purity_deepcopy_maxdepth.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/purity_deepcopy_maxdepth.t 2014-10-09 15:06:36.175174223 -0400
+@@ -0,0 +1,418 @@
++#!./perl -w
++# t/purity_deepcopy_maxdepth.t - Test Purity(), Deepcopy(),
++# Maxdepth() and recursive structures
++
++BEGIN {
++ if ($ENV{PERL_CORE}){
++ require Config; import Config;
++ no warnings 'once';
++ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
++ print "1..0 # Skip: Data::Dumper was not built\n";
++ exit 0;
++ }
++ }
++}
++
++use strict;
++
++use Data::Dumper;
++use Test::More tests => 24;
++use lib qw( ./t/lib );
++use Testing qw( _dumptostr );
++
++my ($a, $b, $c, @d);
++my ($d, $e, $f);
++
++note("\$Data::Dumper::Purity and Purity()");
++
++{
++ my ($obj, %dumps, $purity);
++
++ # Adapted from example in Dumper.pm POD:
++ @d = ('c');
++ $c = \@d;
++ $b = {};
++ $a = [1, $b, $c];
++ $b->{a} = $a;
++ $b->{b} = $a->[1];
++ $b->{c} = $a->[2];
++
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $dumps{'noprev'} = _dumptostr($obj);
++
++ note("Discrepancy between Dumpxs() and Dumpperl() behavior with respect to \$Data::Dumper::Purity = undef");
++ local $Data::Dumper::Useperl = 1;
++ $purity = undef;
++ local $Data::Dumper::Purity = $purity;
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $dumps{'ddpundef'} = _dumptostr($obj);
++
++ $purity = 0;
++ local $Data::Dumper::Purity = $purity;
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $dumps{'ddpzero'} = _dumptostr($obj);
++
++ is($dumps{'noprev'}, $dumps{'ddpundef'},
++ "No previous Purity setting equivalent to \$Data::Dumper::Purity = undef");
++
++ is($dumps{'noprev'}, $dumps{'ddpzero'},
++ "No previous Purity setting equivalent to \$Data::Dumper::Purity = 0");
++}
++
++{
++ my ($obj, %dumps, $purity);
++
++ @d = ('c');
++ $c = \@d;
++ $b = {};
++ $a = [1, $b, $c];
++ $b->{a} = $a;
++ $b->{b} = $a->[1];
++ $b->{c} = $a->[2];
++
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $dumps{'noprev'} = _dumptostr($obj);
++
++ $purity = 0;
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $obj->Purity($purity);
++ $dumps{'objzero'} = _dumptostr($obj);
++
++ is($dumps{'noprev'}, $dumps{'objzero'},
++ "No previous Purity setting equivalent to Purity(0)");
++
++ $purity = undef;
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $obj->Purity($purity);
++ $dumps{'objundef'} = _dumptostr($obj);
++
++ is($dumps{'noprev'}, $dumps{'objundef'},
++ "No previous Purity setting equivalent to Purity(undef)");
++}
++
++{
++ my ($obj, %dumps, $purity);
++
++ @d = ('c');
++ $c = \@d;
++ $b = {};
++ $a = [1, $b, $c];
++ $b->{a} = $a;
++ $b->{b} = $a->[1];
++ $b->{c} = $a->[2];
++
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $dumps{'noprev'} = _dumptostr($obj);
++
++ $purity = 1;
++ local $Data::Dumper::Purity = $purity;
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $dumps{'ddpone'} = _dumptostr($obj);
++
++ isnt($dumps{'noprev'}, $dumps{'ddpone'},
++ "No previous Purity setting different from \$Data::Dumper::Purity = 1");
++}
++
++{
++ my ($obj, %dumps, $purity);
++
++ @d = ('c');
++ $c = \@d;
++ $b = {};
++ $a = [1, $b, $c];
++ $b->{a} = $a;
++ $b->{b} = $a->[1];
++ $b->{c} = $a->[2];
++
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $dumps{'noprev'} = _dumptostr($obj);
++
++ $purity = 1;
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $obj->Purity(1);
++ $dumps{'objone'} = _dumptostr($obj);
++
++ isnt($dumps{'noprev'}, $dumps{'objone'},
++ "No previous Purity setting different from Purity(0)");
++}
++
++{
++ my ($obj, %dumps, $purity);
++
++ @d = ('c');
++ $c = \@d;
++ $b = {};
++ $a = [1, $b, $c];
++ $b->{a} = $a;
++ $b->{b} = $a->[1];
++ $b->{c} = $a->[2];
++
++ $purity = 1;
++ local $Data::Dumper::Purity = $purity;
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $dumps{'ddpone'} = _dumptostr($obj);
++ local $Data::Dumper::Purity = undef;
++
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $obj->Purity(1);
++ $dumps{'objone'} = _dumptostr($obj);
++
++ is($dumps{'ddpone'}, $dumps{'objone'},
++ "\$Data::Dumper::Purity = 1 and Purity(1) are equivalent");
++}
++
++note("\$Data::Dumper::Deepcopy and Deepcopy()");
++
++{
++ my ($obj, %dumps, $deepcopy);
++
++ # Adapted from example in Dumper.pm POD:
++ @d = ('c');
++ $c = \@d;
++ $b = {};
++ $a = [1, $b, $c];
++ $b->{a} = $a;
++ $b->{b} = $a->[1];
++ $b->{c} = $a->[2];
++
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $dumps{'noprev'} = _dumptostr($obj);
++
++ $deepcopy = undef;
++ local $Data::Dumper::Deepcopy = $deepcopy;
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $dumps{'dddundef'} = _dumptostr($obj);
++
++ $deepcopy = 0;
++ local $Data::Dumper::Deepcopy = $deepcopy;
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $dumps{'dddzero'} = _dumptostr($obj);
++
++ is($dumps{'noprev'}, $dumps{'dddundef'},
++ "No previous Deepcopy setting equivalent to \$Data::Dumper::Deepcopy = undef");
++
++ is($dumps{'noprev'}, $dumps{'dddzero'},
++ "No previous Deepcopy setting equivalent to \$Data::Dumper::Deepcopy = 0");
++}
++
++{
++ my ($obj, %dumps, $deepcopy);
++
++ @d = ('c');
++ $c = \@d;
++ $b = {};
++ $a = [1, $b, $c];
++ $b->{a} = $a;
++ $b->{b} = $a->[1];
++ $b->{c} = $a->[2];
++
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $dumps{'noprev'} = _dumptostr($obj);
++
++ $deepcopy = 0;
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $obj->Deepcopy($deepcopy);
++ $dumps{'objzero'} = _dumptostr($obj);
++
++ is($dumps{'noprev'}, $dumps{'objzero'},
++ "No previous Deepcopy setting equivalent to Deepcopy(0)");
++
++ $deepcopy = undef;
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $obj->Deepcopy($deepcopy);
++ $dumps{'objundef'} = _dumptostr($obj);
++
++ is($dumps{'noprev'}, $dumps{'objundef'},
++ "No previous Deepcopy setting equivalent to Deepcopy(undef)");
++}
++
++{
++ my ($obj, %dumps, $deepcopy);
++
++ @d = ('c');
++ $c = \@d;
++ $b = {};
++ $a = [1, $b, $c];
++ $b->{a} = $a;
++ $b->{b} = $a->[1];
++ $b->{c} = $a->[2];
++
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $dumps{'noprev'} = _dumptostr($obj);
++
++ $deepcopy = 1;
++ local $Data::Dumper::Deepcopy = $deepcopy;
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $dumps{'dddone'} = _dumptostr($obj);
++
++ isnt($dumps{'noprev'}, $dumps{'dddone'},
++ "No previous Deepcopy setting different from \$Data::Dumper::Deepcopy = 1");
++}
++
++{
++ my ($obj, %dumps, $deepcopy);
++
++ @d = ('c');
++ $c = \@d;
++ $b = {};
++ $a = [1, $b, $c];
++ $b->{a} = $a;
++ $b->{b} = $a->[1];
++ $b->{c} = $a->[2];
++
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $dumps{'noprev'} = _dumptostr($obj);
++
++ $deepcopy = 1;
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $obj->Deepcopy(1);
++ $dumps{'objone'} = _dumptostr($obj);
++
++ isnt($dumps{'noprev'}, $dumps{'objone'},
++ "No previous Deepcopy setting different from Deepcopy(0)");
++}
++
++{
++ my ($obj, %dumps, $deepcopy);
++
++ @d = ('c');
++ $c = \@d;
++ $b = {};
++ $a = [1, $b, $c];
++ $b->{a} = $a;
++ $b->{b} = $a->[1];
++ $b->{c} = $a->[2];
++
++ $deepcopy = 1;
++ local $Data::Dumper::Deepcopy = $deepcopy;
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $dumps{'dddone'} = _dumptostr($obj);
++ local $Data::Dumper::Deepcopy = undef;
++
++ $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
++ $obj->Deepcopy(1);
++ $dumps{'objone'} = _dumptostr($obj);
++
++ is($dumps{'dddone'}, $dumps{'objone'},
++ "\$Data::Dumper::Deepcopy = 1 and Deepcopy(1) are equivalent");
++}
++
++note("\$Data::Dumper::Maxdepth and Maxdepth()");
++
++{
++ # Adapted from Dumper.pm POD
++
++ my ($obj, %dumps, $maxdepth);
++
++ $a = "pearl";
++ $b = [ $a ];
++ $c = { 'b' => $b };
++ $d = [ $c ];
++ $e = { 'd' => $d };
++ $f = { 'e' => $e };
++
++ note("Discrepancy between Dumpxs() and Dumpperl() behavior with respect to \$Data::Dumper::Maxdepth = undef");
++ local $Data::Dumper::Useperl = 1;
++
++ $obj = Data::Dumper->new([$f], [qw(f)]);
++ $dumps{'noprev'} = _dumptostr($obj);
++
++ $Data::Dumper::Maxdepth = undef;
++ $obj = Data::Dumper->new([$f], [qw(f)]);
++ $dumps{'ddmundef'} = _dumptostr($obj);
++
++ $maxdepth = 3;
++ local $Data::Dumper::Maxdepth = $maxdepth;
++ $obj = Data::Dumper->new([$f], [qw(f)]);
++ $dumps{'ddm'} = _dumptostr($obj);
++
++ is($dumps{'noprev'}, $dumps{'ddmundef'},
++ "No previous Maxdepth setting equivalent to \$Data::Dumper::Maxdepth = undef");
++
++ like($dumps{'noprev'}, qr/$a/s,
++ "Without Maxdepth, got output from deepest level");
++
++ isnt($dumps{'noprev'}, $dumps{'ddm'},
++ "No previous Maxdepth setting differs from setting a shallow Maxdepth");
++
++ unlike($dumps{'ddm'}, qr/$a/s,
++ "With Maxdepth, did not get output from deepest level");
++}
++
++{
++ # Adapted from Dumper.pm POD
++
++ my ($obj, %dumps, $maxdepth);
++
++ $a = "pearl";
++ $b = [ $a ];
++ $c = { 'b' => $b };
++ $d = [ $c ];
++ $e = { 'd' => $d };
++ $f = { 'e' => $e };
++
++ note("Discrepancy between Dumpxs() and Dumpperl() behavior with respect to \$Data::Dumper::Maxdepth = undef");
++ local $Data::Dumper::Useperl = 1;
++
++ $obj = Data::Dumper->new([$f], [qw(f)]);
++ $dumps{'noprev'} = _dumptostr($obj);
++
++ $obj = Data::Dumper->new([$f], [qw(f)]);
++ $obj->Maxdepth();
++ $dumps{'maxdepthempty'} = _dumptostr($obj);
++
++ is($dumps{'noprev'}, $dumps{'maxdepthempty'},
++ "No previous Maxdepth setting equivalent to Maxdepth() with no argument");
++
++ $obj = Data::Dumper->new([$f], [qw(f)]);
++ $obj->Maxdepth(undef);
++ $dumps{'maxdepthundef'} = _dumptostr($obj);
++
++ is($dumps{'noprev'}, $dumps{'maxdepthundef'},
++ "No previous Maxdepth setting equivalent to Maxdepth(undef)");
++
++ $maxdepth = 3;
++ $obj = Data::Dumper->new([$f], [qw(f)]);
++ $obj->Maxdepth($maxdepth);
++ $dumps{'maxdepthset'} = _dumptostr($obj);
++
++ isnt($dumps{'noprev'}, $dumps{'maxdepthset'},
++ "No previous Maxdepth setting differs from Maxdepth() with shallow depth");
++
++ local $Data::Dumper::Maxdepth = 3;
++ $obj = Data::Dumper->new([$f], [qw(f)]);
++ $dumps{'ddmset'} = _dumptostr($obj);
++
++ is($dumps{'maxdepthset'}, $dumps{'ddmset'},
++ "Maxdepth set and \$Data::Dumper::Maxdepth are equivalent");
++}
++
++{
++ my ($obj, %dumps);
++
++ my $warning = '';
++ local $SIG{__WARN__} = sub { $warning = $_[0] };
++
++ local $Data::Dumper::Deparse = 0;
++ local $Data::Dumper::Purity = 1;
++ local $Data::Dumper::Useperl = 1;
++ sub hello { print "Hello world\n"; }
++ $obj = Data::Dumper->new( [ \&hello ] );
++ $dumps{'ddsksub'} = _dumptostr($obj);
++ like($warning, qr/^Encountered CODE ref, using dummy placeholder/,
++ "Got expected warning: dummy placeholder under Purity = 1");
++}
++
++{
++ my ($obj, %dumps);
++
++ my $warning = '';
++ local $SIG{__WARN__} = sub { $warning = $_[0] };
++
++ local $Data::Dumper::Deparse = 0;
++ local $Data::Dumper::Useperl = 1;
++ sub jello { print "Jello world\n"; }
++ $obj = Data::Dumper->new( [ \&hello ] );
++ $dumps{'ddsksub'} = _dumptostr($obj);
++ ok(! $warning, "Encountered CODE ref, but no Purity, hence no warning");
++}
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/qr.t perl-5.12.5_dumper/dist/Data-Dumper/t/qr.t
+--- perl-5.12.5/dist/Data-Dumper/t/qr.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/qr.t 2014-10-09 15:06:36.179661797 -0400
+@@ -0,0 +1,24 @@
++#!perl -X
++
++BEGIN {
++ require Config; import Config;
++ no warnings 'once';
++ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
++ print "1..0 # Skip: Data::Dumper was not built\n";
++ exit 0;
++ }
++}
++
++use Test::More tests => 2;
++use Data::Dumper;
++
++{
++ my $q = q| \/ |;
++ use Data::Dumper;
++ my $qr = qr{$q};
++ eval Dumper $qr;
++ ok(!$@, "Dumping $qr with XS") or diag $@, Dumper $qr;
++ local $Data::Dumper::Useperl = 1;
++ eval Dumper $qr;
++ ok(!$@, "Dumping $qr with PP") or diag $@, Dumper $qr;
++}
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/quotekeys.t perl-5.12.5_dumper/dist/Data-Dumper/t/quotekeys.t
+--- perl-5.12.5/dist/Data-Dumper/t/quotekeys.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/quotekeys.t 2014-10-09 15:06:36.178495322 -0400
+@@ -0,0 +1,135 @@
++#!./perl -w
++# t/quotekeys.t - Test Quotekeys()
++
++BEGIN {
++ if ($ENV{PERL_CORE}){
++ require Config; import Config;
++ no warnings 'once';
++ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
++ print "1..0 # Skip: Data::Dumper was not built\n";
++ exit 0;
++ }
++ }
++}
++
++use strict;
++
++use Data::Dumper;
++use Test::More tests => 18;
++use lib qw( ./t/lib );
++use Testing qw( _dumptostr );
++
++my %d = (
++ delta => 'd',
++ beta => 'b',
++ gamma => 'c',
++ alpha => 'a',
++);
++
++run_tests_for_quotekeys();
++SKIP: {
++ skip "XS version was unavailable, so we already ran with pure Perl", 5
++ if $Data::Dumper::Useperl;
++ local $Data::Dumper::Useperl = 1;
++ run_tests_for_quotekeys();
++}
++
++sub run_tests_for_quotekeys {
++ note("\$Data::Dumper::Useperl = $Data::Dumper::Useperl");
++
++ my ($obj, %dumps, $quotekeys, $starting);
++
++ note("\$Data::Dumper::Quotekeys and Quotekeys() set to true value");
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddqkdefault'} = _dumptostr($obj);
++
++ $starting = $Data::Dumper::Quotekeys;
++ $quotekeys = 1;
++ local $Data::Dumper::Quotekeys = $quotekeys;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddqkone'} = _dumptostr($obj);
++ local $Data::Dumper::Quotekeys = $starting;
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $obj->Quotekeys($quotekeys);
++ $dumps{'objqkone'} = _dumptostr($obj);
++
++ is($dumps{'ddqkdefault'}, $dumps{'ddqkone'},
++ "\$Data::Dumper::Quotekeys = 1 is default");
++ is($dumps{'ddqkone'}, $dumps{'objqkone'},
++ "\$Data::Dumper::Quotekeys = 1 and Quotekeys(1) are equivalent");
++ %dumps = ();
++
++ $quotekeys = 0;
++ local $Data::Dumper::Quotekeys = $quotekeys;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddqkzero'} = _dumptostr($obj);
++ local $Data::Dumper::Quotekeys = $starting;
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $obj->Quotekeys($quotekeys);
++ $dumps{'objqkzero'} = _dumptostr($obj);
++
++ is($dumps{'ddqkzero'}, $dumps{'objqkzero'},
++ "\$Data::Dumper::Quotekeys = 0 and Quotekeys(0) are equivalent");
++
++ $quotekeys = undef;
++ local $Data::Dumper::Quotekeys = $quotekeys;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddqkundef'} = _dumptostr($obj);
++ local $Data::Dumper::Quotekeys = $starting;
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $obj->Quotekeys($quotekeys);
++ $dumps{'objqkundef'} = _dumptostr($obj);
++
++ note("Quotekeys(undef) will fall back to the default value\nfor \$Data::Dumper::Quotekeys, which is a true value.");
++ isnt($dumps{'ddqkundef'}, $dumps{'objqkundef'},
++ "\$Data::Dumper::Quotekeys = undef and Quotekeys(undef) are equivalent");
++ isnt($dumps{'ddqkzero'}, $dumps{'objqkundef'},
++ "\$Data::Dumper::Quotekeys = undef and = 0 are equivalent");
++ %dumps = ();
++
++ local $Data::Dumper::Quotekeys = 1;
++ local $Data::Dumper::Sortkeys = 1;
++ local $Data::Dumper::Indent = 0;
++ local $Data::Dumper::Useqq = 0;
++
++ my %qkdata =
++ (
++ 0 => 1,
++ '012345' => 1,
++ 12 => 1,
++ 123456789 => 1,
++ 1234567890 => 1,
++ '::de::fg' => 1,
++ ab => 1,
++ 'hi::12' => 1,
++ "1\x{660}" => 1,
++ );
++
++ is(Dumper(\%qkdata),
++ q($VAR1 = {'0' => 1,'012345' => 1,'12' => 1,'123456789' => 1,'1234567890' => 1,"1\x{660}" => 1,'::de::fg' => 1,'ab' => 1,'hi::12' => 1};),
++ "always quote when quotekeys true");
++
++ {
++ local $Data::Dumper::Useqq = 1;
++ is(Dumper(\%qkdata),
++ q($VAR1 = {"0" => 1,"012345" => 1,"12" => 1,"123456789" => 1,"1234567890" => 1,"1\x{660}" => 1,"::de::fg" => 1,"ab" => 1,"hi::12" => 1};),
++ "always quote when quotekeys true (useqq)");
++ }
++
++ local $Data::Dumper::Quotekeys = 0;
++
++ is(Dumper(\%qkdata),
++ q($VAR1 = {0 => 1,'012345' => 1,12 => 1,123456789 => 1,'1234567890' => 1,"1\x{660}" => 1,'::de::fg' => 1,ab => 1,'hi::12' => 1};),
++ "avoid quotes when quotekeys false");
++ {
++ local $Data::Dumper::Useqq = 1;
++ is(Dumper(\%qkdata),
++ q($VAR1 = {0 => 1,"012345" => 1,12 => 1,123456789 => 1,"1234567890" => 1,"1\x{660}" => 1,"::de::fg" => 1,ab => 1,"hi::12" => 1};),
++ "avoid quotes when quotekeys false (useqq)");
++ }
++}
++
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/recurse.t perl-5.12.5_dumper/dist/Data-Dumper/t/recurse.t
+--- perl-5.12.5/dist/Data-Dumper/t/recurse.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/recurse.t 2014-10-09 15:06:36.172817083 -0400
+@@ -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 -ur --new-file perl-5.12.5/dist/Data-Dumper/t/seen.t perl-5.12.5_dumper/dist/Data-Dumper/t/seen.t
+--- perl-5.12.5/dist/Data-Dumper/t/seen.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/seen.t 2014-10-09 15:06:36.179175807 -0400
+@@ -0,0 +1,103 @@
++#!./perl -w
++# t/seen.t - Test Seen()
++
++BEGIN {
++ if ($ENV{PERL_CORE}){
++ require Config; import Config;
++ no warnings 'once';
++ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
++ print "1..0 # Skip: Data::Dumper was not built\n";
++ exit 0;
++ }
++ }
++}
++
++use strict;
++
++use Data::Dumper;
++use Test::More tests => 10;
++use lib qw( ./t/lib );
++use Testing qw( _dumptostr );
++
++my ($obj, %dumps);
++
++my (@e, %f, @rv, @g, %h, $k);
++@e = ( qw| alpha beta gamma | );
++%f = ( epsilon => 'zeta', eta => 'theta' );
++@g = ( qw| iota kappa lambda | );
++%h = ( mu => 'nu', omicron => 'pi' );
++sub j { print "Hello world\n"; }
++$k = 'just another scalar';
++
++{
++ my $warning = '';
++ local $SIG{__WARN__} = sub { $warning = $_[0] };
++
++ $obj = Data::Dumper->new( [ \@e, \%f ]);
++ @rv = $obj->Seen( { mark => 'snark' } );
++ like($warning,
++ qr/^Only refs supported, ignoring non-ref item \$mark/,
++ "Got expected warning for non-ref item");
++}
++
++{
++ my $warning = '';
++ local $SIG{__WARN__} = sub { $warning = $_[0] };
++
++ $obj = Data::Dumper->new( [ \@e, \%f ]);
++ @rv = $obj->Seen( { mark => undef } );
++ like($warning,
++ qr/^Value of ref must be defined; ignoring undefined item \$mark/,
++ "Got expected warning for undefined value of item");
++}
++
++{
++ $obj = Data::Dumper->new( [ \@e, \%f ]);
++ @rv = $obj->Seen( undef );
++ is(@rv, 0, "Seen(undef) returned empty array");
++}
++
++{
++ $obj = Data::Dumper->new( [ \@e, \%f ]);
++ @rv = $obj->Seen( [ qw| mark snark | ] );
++ is(@rv, 0, "Seen(ref other than hashref) returned empty array");
++}
++
++{
++ $obj = Data::Dumper->new( [ \@e, \%f ]);
++ @rv = $obj->Seen( { '*samba' => \@g } );
++ is_deeply($rv[0], $obj, "Got the object back: value array ref");
++}
++
++{
++ $obj = Data::Dumper->new( [ \@e, \%f ]);
++ @rv = $obj->Seen( { '*canasta' => \%h } );
++ is_deeply($rv[0], $obj, "Got the object back: value hash ref");
++}
++
++{
++ $obj = Data::Dumper->new( [ \@e, \%f ]);
++ @rv = $obj->Seen( { '*pinochle' => \&j } );
++ is_deeply($rv[0], $obj, "Got the object back: value code ref");
++}
++
++{
++ $obj = Data::Dumper->new( [ \@e, \%f ]);
++ @rv = $obj->Seen( { '*poker' => \$k } );
++ is_deeply($rv[0], $obj, "Got the object back: value ref to scalar");
++}
++
++{
++ my $l = 'loo';
++ $obj = Data::Dumper->new( [ \@e, \%f ]);
++ @rv = $obj->Seen( { $l => \$k } );
++ is_deeply($rv[0], $obj, "Got the object back: value ref to scalar");
++}
++
++{
++ my $l = '$loo';
++ $obj = Data::Dumper->new( [ \@e, \%f ]);
++ @rv = $obj->Seen( { $l => \$k } );
++ is_deeply($rv[0], $obj, "Got the object back: value ref to scalar");
++}
++
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/sortkeys.t perl-5.12.5_dumper/dist/Data-Dumper/t/sortkeys.t
+--- perl-5.12.5/dist/Data-Dumper/t/sortkeys.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/sortkeys.t 2014-10-09 15:06:36.174321223 -0400
+@@ -0,0 +1,190 @@
++#!./perl -w
++# t/sortkeys.t - Test Sortkeys()
++
++BEGIN {
++ if ($ENV{PERL_CORE}){
++ require Config; import Config;
++ no warnings 'once';
++ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
++ print "1..0 # Skip: Data::Dumper was not built\n";
++ exit 0;
++ }
++ }
++}
++
++use strict;
++
++use Data::Dumper;
++use Test::More tests => 26;
++use lib qw( ./t/lib );
++use Testing qw( _dumptostr );
++
++run_tests_for_sortkeys();
++SKIP: {
++ skip "XS version was unavailable, so we already ran with pure Perl", 13
++ if $Data::Dumper::Useperl;
++ local $Data::Dumper::Useperl = 1;
++ run_tests_for_sortkeys();
++}
++
++sub run_tests_for_sortkeys {
++ note("\$Data::Dumper::Useperl = $Data::Dumper::Useperl");
++
++ my %d = (
++ delta => 'd',
++ beta => 'b',
++ gamma => 'c',
++ alpha => 'a',
++ );
++
++ {
++ my ($obj, %dumps, $sortkeys, $starting);
++
++ note("\$Data::Dumper::Sortkeys and Sortkeys() set to true value");
++
++ $starting = $Data::Dumper::Sortkeys;
++ $sortkeys = 1;
++ local $Data::Dumper::Sortkeys = $sortkeys;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddskone'} = _dumptostr($obj);
++ local $Data::Dumper::Sortkeys = $starting;
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $obj->Sortkeys($sortkeys);
++ $dumps{'objskone'} = _dumptostr($obj);
++
++ is($dumps{'ddskone'}, $dumps{'objskone'},
++ "\$Data::Dumper::Sortkeys = 1 and Sortkeys(1) are equivalent");
++ like($dumps{'ddskone'},
++ qr/alpha.*?beta.*?delta.*?gamma/s,
++ "Sortkeys returned hash keys in Perl's default sort order");
++ %dumps = ();
++
++ }
++
++ {
++ my ($obj, %dumps, $starting);
++
++ note("\$Data::Dumper::Sortkeys and Sortkeys() set to coderef");
++
++ $starting = $Data::Dumper::Sortkeys;
++ local $Data::Dumper::Sortkeys = \&reversekeys;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddsksub'} = _dumptostr($obj);
++ local $Data::Dumper::Sortkeys = $starting;
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $obj->Sortkeys(\&reversekeys);
++ $dumps{'objsksub'} = _dumptostr($obj);
++
++ is($dumps{'ddsksub'}, $dumps{'objsksub'},
++ "\$Data::Dumper::Sortkeys = CODEREF and Sortkeys(CODEREF) are equivalent");
++ like($dumps{'ddsksub'},
++ qr/gamma.*?delta.*?beta.*?alpha/s,
++ "Sortkeys returned hash keys per sorting subroutine");
++ %dumps = ();
++
++ }
++
++ {
++ my ($obj, %dumps, $starting);
++
++ note("\$Data::Dumper::Sortkeys and Sortkeys() set to coderef with filter");
++ $starting = $Data::Dumper::Sortkeys;
++ local $Data::Dumper::Sortkeys = \&reversekeystrim;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddsksub'} = _dumptostr($obj);
++ local $Data::Dumper::Sortkeys = $starting;
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $obj->Sortkeys(\&reversekeystrim);
++ $dumps{'objsksub'} = _dumptostr($obj);
++
++ is($dumps{'ddsksub'}, $dumps{'objsksub'},
++ "\$Data::Dumper::Sortkeys = CODEREF and Sortkeys(CODEREF) select same keys");
++ like($dumps{'ddsksub'},
++ qr/gamma.*?delta.*?beta/s,
++ "Sortkeys returned hash keys per sorting subroutine");
++ unlike($dumps{'ddsksub'},
++ qr/alpha/s,
++ "Sortkeys filtered out one key per request");
++ %dumps = ();
++
++ }
++
++ {
++ my ($obj, %dumps, $sortkeys, $starting);
++
++ note("\$Data::Dumper::Sortkeys(undef) and Sortkeys(undef)");
++
++ $starting = $Data::Dumper::Sortkeys;
++ $sortkeys = 0;
++ local $Data::Dumper::Sortkeys = $sortkeys;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddskzero'} = _dumptostr($obj);
++ local $Data::Dumper::Sortkeys = $starting;
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $obj->Sortkeys($sortkeys);
++ $dumps{'objskzero'} = _dumptostr($obj);
++
++ $sortkeys = undef;
++ local $Data::Dumper::Sortkeys = $sortkeys;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddskundef'} = _dumptostr($obj);
++ local $Data::Dumper::Sortkeys = $starting;
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $obj->Sortkeys($sortkeys);
++ $dumps{'objskundef'} = _dumptostr($obj);
++
++ is($dumps{'ddskzero'}, $dumps{'objskzero'},
++ "\$Data::Dumper::Sortkeys = 0 and Sortkeys(0) are equivalent");
++ is($dumps{'ddskzero'}, $dumps{'ddskundef'},
++ "\$Data::Dumper::Sortkeys = 0 and = undef equivalent");
++ is($dumps{'objkzero'}, $dumps{'objkundef'},
++ "Sortkeys(0) and Sortkeys(undef) are equivalent");
++ %dumps = ();
++
++ }
++
++ note("Internal subroutine _sortkeys");
++ my %e = (
++ nu => 'n',
++ lambda => 'l',
++ kappa => 'k',
++ mu => 'm',
++ omicron => 'o',
++ );
++ my $rv = Data::Dumper::_sortkeys(\%e);
++ is(ref($rv), 'ARRAY', "Data::Dumper::_sortkeys returned an array ref");
++ is_deeply($rv, [ qw( kappa lambda mu nu omicron ) ],
++ "Got keys in Perl default order");
++ {
++ my $warning = '';
++ local $SIG{__WARN__} = sub { $warning = $_[0] };
++
++ my ($obj, %dumps, $starting);
++
++ note("\$Data::Dumper::Sortkeys and Sortkeys() set to coderef");
++
++ $starting = $Data::Dumper::Sortkeys;
++ local $Data::Dumper::Sortkeys = \&badreturnvalue;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddsksub'} = _dumptostr($obj);
++ like($warning, qr/^Sortkeys subroutine did not return ARRAYREF/,
++ "Got expected warning: sorting routine did not return array ref");
++ }
++
++}
++
++sub reversekeys { return [ reverse sort keys %{+shift} ]; }
++
++sub reversekeystrim {
++ my $hr = shift;
++ my @keys = sort keys %{$hr};
++ shift(@keys);
++ return [ reverse @keys ];
++}
++
++sub badreturnvalue { return { %{+shift} }; }
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/sparseseen.t perl-5.12.5_dumper/dist/Data-Dumper/t/sparseseen.t
+--- perl-5.12.5/dist/Data-Dumper/t/sparseseen.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/sparseseen.t 2014-10-09 15:06:36.176307692 -0400
+@@ -0,0 +1,88 @@
++#!./perl -w
++# t/sparseseen.t - Test Sparseseen()
++
++BEGIN {
++ if ($ENV{PERL_CORE}){
++ require Config; import Config;
++ no warnings 'once';
++ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
++ print "1..0 # Skip: Data::Dumper was not built\n";
++ exit 0;
++ }
++ }
++}
++
++use strict;
++
++use Data::Dumper;
++use Test::More tests => 8;
++use lib qw( ./t/lib );
++use Testing qw( _dumptostr );
++
++my %d = (
++ delta => 'd',
++ beta => 'b',
++ gamma => 'c',
++ alpha => 'a',
++);
++
++run_tests_for_sparseseen();
++SKIP: {
++ skip "XS version was unavailable, so we already ran with pure Perl", 4
++ if $Data::Dumper::Useperl;
++ local $Data::Dumper::Useperl = 1;
++ run_tests_for_sparseseen();
++}
++
++sub run_tests_for_sparseseen {
++ note("\$Data::Dumper::Useperl = $Data::Dumper::Useperl");
++
++ my ($obj, %dumps, $sparseseen, $starting);
++
++ note("\$Data::Dumper::Sparseseen and Sparseseen() set to true value");
++
++ $starting = $Data::Dumper::Sparseseen;
++ $sparseseen = 1;
++ local $Data::Dumper::Sparseseen = $sparseseen;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddssone'} = _dumptostr($obj);
++ local $Data::Dumper::Sparseseen = $starting;
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $obj->Sparseseen($sparseseen);
++ $dumps{'objssone'} = _dumptostr($obj);
++
++ is($dumps{'ddssone'}, $dumps{'objssone'},
++ "\$Data::Dumper::Sparseseen = 1 and Sparseseen(1) are equivalent");
++ %dumps = ();
++
++ $sparseseen = 0;
++ local $Data::Dumper::Sparseseen = $sparseseen;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddsszero'} = _dumptostr($obj);
++ local $Data::Dumper::Sparseseen = $starting;
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $obj->Sparseseen($sparseseen);
++ $dumps{'objsszero'} = _dumptostr($obj);
++
++ is($dumps{'ddsszero'}, $dumps{'objsszero'},
++ "\$Data::Dumper::Sparseseen = 0 and Sparseseen(0) are equivalent");
++
++ $sparseseen = undef;
++ local $Data::Dumper::Sparseseen = $sparseseen;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddssundef'} = _dumptostr($obj);
++ local $Data::Dumper::Sparseseen = $starting;
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $obj->Sparseseen($sparseseen);
++ $dumps{'objssundef'} = _dumptostr($obj);
++
++ is($dumps{'ddssundef'}, $dumps{'objssundef'},
++ "\$Data::Dumper::Sparseseen = undef and Sparseseen(undef) are equivalent");
++ is($dumps{'ddsszero'}, $dumps{'objssundef'},
++ "\$Data::Dumper::Sparseseen = undef and = 0 are equivalent");
++ %dumps = ();
++}
++
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/terse.t perl-5.12.5_dumper/dist/Data-Dumper/t/terse.t
+--- perl-5.12.5/dist/Data-Dumper/t/terse.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/terse.t 2014-10-09 15:06:36.177303482 -0400
+@@ -0,0 +1,61 @@
++#!perl
++use strict;
++use warnings;
++
++use Data::Dumper;
++use Test::More tests => 6;
++use lib qw( ./t/lib );
++use Testing qw( _dumptostr );
++
++
++my $hash = { foo => 42 };
++
++for my $useperl (0..1) {
++ my $dumper = Data::Dumper->new([$hash]);
++ $dumper->Terse(1);
++ $dumper->Indent(2);
++ $dumper->Useperl($useperl);
++
++ is $dumper->Dump, <<'WANT', "Terse(1), Indent(2), Useperl($useperl)";
++{
++ 'foo' => 42
++}
++WANT
++}
++
++my (%dumpstr);
++my $dumper;
++
++$dumper = Data::Dumper->new([$hash]);
++$dumpstr{noterse} = _dumptostr($dumper);
++# $VAR1 = {
++# 'foo' => 42
++# };
++
++$dumper = Data::Dumper->new([$hash]);
++$dumper->Terse();
++$dumpstr{terse_no_arg} = _dumptostr($dumper);
++
++$dumper = Data::Dumper->new([$hash]);
++$dumper->Terse(0);
++$dumpstr{terse_0} = _dumptostr($dumper);
++
++$dumper = Data::Dumper->new([$hash]);
++$dumper->Terse(1);
++$dumpstr{terse_1} = _dumptostr($dumper);
++# {
++# 'foo' => 42
++# }
++
++$dumper = Data::Dumper->new([$hash]);
++$dumper->Terse(undef);
++$dumpstr{terse_undef} = _dumptostr($dumper);
++
++is($dumpstr{noterse}, $dumpstr{terse_no_arg},
++ "absence of Terse is same as Terse()");
++is($dumpstr{noterse}, $dumpstr{terse_0},
++ "absence of Terse is same as Terse(0)");
++isnt($dumpstr{noterse}, $dumpstr{terse_1},
++ "absence of Terse is different from Terse(1)");
++is($dumpstr{noterse}, $dumpstr{terse_undef},
++ "absence of Terse is same as Terse(undef)");
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/toaster.t perl-5.12.5_dumper/dist/Data-Dumper/t/toaster.t
+--- perl-5.12.5/dist/Data-Dumper/t/toaster.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/toaster.t 2014-10-09 15:06:36.180160759 -0400
+@@ -0,0 +1,88 @@
++#!./perl -w
++# t/toaster.t - Test Toaster()
++
++BEGIN {
++ if ($ENV{PERL_CORE}){
++ require Config; import Config;
++ no warnings 'once';
++ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
++ print "1..0 # Skip: Data::Dumper was not built\n";
++ exit 0;
++ }
++ }
++}
++
++use strict;
++
++use Data::Dumper;
++use Test::More tests => 8;
++use lib qw( ./t/lib );
++use Testing qw( _dumptostr );
++
++my %d = (
++ delta => 'd',
++ beta => 'b',
++ gamma => 'c',
++ alpha => 'a',
++);
++
++run_tests_for_toaster();
++SKIP: {
++ skip "XS version was unavailable, so we already ran with pure Perl", 4
++ if $Data::Dumper::Useperl;
++ local $Data::Dumper::Useperl = 1;
++ run_tests_for_toaster();
++}
++
++sub run_tests_for_toaster {
++ note("\$Data::Dumper::Useperl = $Data::Dumper::Useperl");
++
++ my ($obj, %dumps, $toaster, $starting);
++
++ note("\$Data::Dumper::Toaster and Toaster() set to true value");
++
++ $starting = $Data::Dumper::Toaster;
++ $toaster = 1;
++ local $Data::Dumper::Toaster = $toaster;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddtoasterone'} = _dumptostr($obj);
++ local $Data::Dumper::Toaster = $starting;
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $obj->Toaster($toaster);
++ $dumps{'objtoasterone'} = _dumptostr($obj);
++
++ is($dumps{'ddtoasterone'}, $dumps{'objtoasterone'},
++ "\$Data::Dumper::Toaster = 1 and Toaster(1) are equivalent");
++ %dumps = ();
++
++ $toaster = 0;
++ local $Data::Dumper::Toaster = $toaster;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddtoasterzero'} = _dumptostr($obj);
++ local $Data::Dumper::Toaster = $starting;
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $obj->Toaster($toaster);
++ $dumps{'objtoasterzero'} = _dumptostr($obj);
++
++ is($dumps{'ddtoasterzero'}, $dumps{'objtoasterzero'},
++ "\$Data::Dumper::Toaster = 0 and Toaster(0) are equivalent");
++
++ $toaster = undef;
++ local $Data::Dumper::Toaster = $toaster;
++ $obj = Data::Dumper->new( [ \%d ] );
++ $dumps{'ddtoasterundef'} = _dumptostr($obj);
++ local $Data::Dumper::Toaster = $starting;
++
++ $obj = Data::Dumper->new( [ \%d ] );
++ $obj->Toaster($toaster);
++ $dumps{'objtoasterundef'} = _dumptostr($obj);
++
++ is($dumps{'ddtoasterundef'}, $dumps{'objtoasterundef'},
++ "\$Data::Dumper::Toaster = undef and Toaster(undef) are equivalent");
++ is($dumps{'ddtoasterzero'}, $dumps{'objtoasterundef'},
++ "\$Data::Dumper::Toaster = undef and = 0 are equivalent");
++ %dumps = ();
++}
++
+diff -ur --new-file perl-5.12.5/dist/Data-Dumper/t/values.t perl-5.12.5_dumper/dist/Data-Dumper/t/values.t
+--- perl-5.12.5/dist/Data-Dumper/t/values.t 1969-12-31 19:00:00.000000000 -0500
++++ perl-5.12.5_dumper/dist/Data-Dumper/t/values.t 2014-10-09 15:06:36.178013829 -0400
+@@ -0,0 +1,40 @@
++#!./perl -w
++
++BEGIN {
++ if ($ENV{PERL_CORE}){
++ require Config; import Config;
++ no warnings 'once';
++ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
++ print "1..0 # Skip: Data::Dumper was not built\n";
++ exit 0;
++ }
++ }
++}
++
++use strict;
++use Data::Dumper;
++use Test::More tests => 4;
++
++my ($a, $b, $obj);
++my (@values, @names);
++my (@newvalues, $objagain, %newvalues);
++$a = 'alpha';
++$b = 'beta';
++
++$obj = Data::Dumper->new([$a,$b], [qw(a b)]);
++@values = $obj->Values;
++is_deeply(\@values, [$a,$b], "Values() returned expected list");
++
++@newvalues = ( qw| gamma delta epsilon | );
++$objagain = $obj->Values(\@newvalues);
++is($objagain, $obj, "Values returned same object");
++is_deeply($objagain->{todump}, \@newvalues,
++ "Able to use Values() to set values to be dumped");
++
++$obj = Data::Dumper->new([$a,$b], [qw(a b)]);
++%newvalues = ( gamma => 'delta', epsilon => 'zeta' );
++eval { @values = $obj->Values(\%newvalues); };
++like($@, qr/Argument to Values, if provided, must be array ref/,
++ "Got expected error message: bad argument to Values()");
++
++
+diff -ur --new-file perl-5.12.5/ext/B/t/concise-xs.t perl-5.12.5_dumper/ext/B/t/concise-xs.t
+--- perl-5.12.5/ext/B/t/concise-xs.t 2012-11-03 19:26:00.000000000 -0400
++++ perl-5.12.5_dumper/ext/B/t/concise-xs.t 2014-10-09 14:41:00.586972981 -0400
+@@ -127,7 +127,8 @@
+ Digest::MD5 => { perl => [qw/ import /],
+ dflt => 'XS' },
+
+- Data::Dumper => { XS => [qw/ bootstrap Dumpxs /],
++ Data::Dumper => { XS => [qw/ bootstrap Dumpxs _vstring /],
++ constant => ['_bad_vsmg'],
+ dflt => 'perl' },
+ B => {
+ dflt => 'constant', # all but 47/297
+diff -ur --new-file perl-5.12.5/MANIFEST perl-5.12.5_dumper/MANIFEST
+--- perl-5.12.5/MANIFEST 2012-11-03 19:25:58.000000000 -0400
++++ perl-5.12.5_dumper/MANIFEST 2014-10-09 14:42:04.829633708 -0400
+@@ -2602,13 +2602,37 @@
+ dist/Data-Dumper/Changes Data pretty printer, changelog
+ dist/Data-Dumper/Dumper.pm Data pretty printer, module
+ dist/Data-Dumper/Dumper.xs Data pretty printer, externals
++dist/Data-Dumper/Makefile.PL
++dist/Data-Dumper/MANIFEST This list of files
++dist/Data-Dumper/MANIFEST.SKIP
++dist/Data-Dumper/META.yml Module meta-data (added by MakeMaker)
++dist/Data-Dumper/ppport.h
+ dist/Data-Dumper/t/bless.t See if Data::Dumper works
++dist/Data-Dumper/t/bless_var_method.t
+ dist/Data-Dumper/t/bugs.t See if Data::Dumper works
++dist/Data-Dumper/t/deparse.t
+ dist/Data-Dumper/t/dumper.t See if Data::Dumper works
++dist/Data-Dumper/t/dumpperl.t
+ dist/Data-Dumper/t/freezer.t See if $Data::Dumper::Freezer works
++dist/Data-Dumper/t/freezer_useperl.t
++dist/Data-Dumper/t/indent.t
++dist/Data-Dumper/t/lib/Testing.pm
++dist/Data-Dumper/t/misc.t
++dist/Data-Dumper/t/names.t
+ dist/Data-Dumper/Todo Data pretty printer, futures
+ dist/Data-Dumper/t/overload.t See if Data::Dumper works for overloaded data
+ dist/Data-Dumper/t/pair.t See if Data::Dumper pair separator works
++dist/Data-Dumper/t/perl-74170.t
++dist/Data-Dumper/t/purity_deepcopy_maxdepth.t
++dist/Data-Dumper/t/qr.t
++dist/Data-Dumper/t/quotekeys.t
++dist/Data-Dumper/t/recurse.t
++dist/Data-Dumper/t/seen.t
++dist/Data-Dumper/t/sortkeys.t
++dist/Data-Dumper/t/sparseseen.t
++dist/Data-Dumper/t/terse.t
++dist/Data-Dumper/t/toaster.t
++dist/Data-Dumper/t/values.t
+ dist/ExtUtils-Install/Changes ExtUtils-Install change log
+ dist/ExtUtils-Install/lib/ExtUtils/Installed.pm Information on installed extensions
+ dist/ExtUtils-Install/lib/ExtUtils/Install.pm Handles 'make install' on extensions