diff -urp /tmp/mga3/perl/BUILD/perl-5.16.3/dist/Data-Dumper/t/bless.t t/bless.t
--- perl-5.16.3.orig/dist/Data-Dumper/t/bless.t 2013-03-04 10:16:21.000000000 -0500
+++ perl-5.16.3/dist/Data-Dumper/t/bless.t 2014-03-07 02:46:55.000000000 -0500
@@ -5,16 +5,22 @@ use Test::More 0.60;
# 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,8 +49,8 @@ SKIP: {
my $t = bless( qr//, 'foo');
my $dt = Dumper($t);
-my $o = ($] >= 5.013006 ? <<'PERL' : <<'PERL_LEGACY');
-$VAR1 = bless( qr/(?^:)/, 'foo' );
+my $o = ($] > 5.010 ? <<'PERL' : <<'PERL_LEGACY');
+$VAR1 = bless( qr//, 'foo' );
PERL
$VAR1 = bless( qr/(?-xism:)/, 'foo' );
PERL_LEGACY
@@ -52,4 +58,5 @@ PERL_LEGACY
is($dt, $o, "We can dump blessed qr//'s properly");
}
-}
+
+} # END sub run_tests_for_bless()
Only in t: bless_var_method.t
diff -urp /tmp/mga3/perl/BUILD/perl-5.16.3/dist/Data-Dumper/t/bugs.t t/bugs.t
--- perl-5.16.3.orig/dist/Data-Dumper/t/bugs.t 2013-03-04 10:16:21.000000000 -0500
+++ perl-5.16.3/dist/Data-Dumper/t/bugs.t 2013-03-15 04:56:45.000000000 -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;
Only in t: deparse.t
diff -urp /tmp/mga3/perl/BUILD/perl-5.16.3/dist/Data-Dumper/t/dumper.t t/dumper.t
--- perl-5.16.3.orig/dist/Data-Dumper/t/dumper.t 2013-03-04 10:16:21.000000000 -0500
+++ perl-5.16.3/dist/Data-Dumper/t/dumper.t 2014-09-18 11:40:35.000000000 -0400
@@ -30,44 +30,44 @@ sub TEST {
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 @@ sub SKIP_TEST {
$Data::Dumper::Useperl = 1;
if (defined &Data::Dumper::Dumpxs) {
print "### XS extension loaded, will run XS tests\n";
- $TMAX = 390; $XS = 1;
+ $TMAX = 438; $XS = 1;
}
else {
print "### XS extensions not loaded, will NOT run XS tests\n";
- $TMAX = 195; $XS = 0;
+ $TMAX = 219; $XS = 0;
}
print "1..$TMAX\n";
@@ -122,8 +122,20 @@ $WANT = <<'EOT';
#$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 @@ $WANT = <<'EOT';
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 @@ $WANT = <<'EOT';
#$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 @@ $WANT = <<'EOT';
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 @@ EOT
$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 @@ $WANT = <<'EOT';
#$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 @@ EOT
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 @@ $foo = { "abc\000\'\efg" => "mno\000",
};
{
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 @@ EOT
$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
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 @@ EOT
#$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 @@ EOT
#$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 @@ EOT
$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 @@ EOT
#$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 @@ EOT
$dogs[2] = \%kennel;
$mutts = \%kennel;
$mutts = $mutts; # avoid warning
-
+
############# 85
##
$WANT = <<'EOT';
@@ -510,19 +552,21 @@ EOT
#%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 @@ EOT
#%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 @@ EOT
#%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 @@ EOT
#%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
#);
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 @@ $c = [ \&z ];
#];
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 @@ TEST q(Data::Dumper->new([\&z,$c],['a','
#];
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 @@ TEST q(Data::Dumper->new([\&z,$c],['a','
#);
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 @@ TEST q(Data::Dumper->new([\&z,$c],['*a',
#$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 @@ TEST q(Data::Dumper->new([$a],['*a'])->P
#$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 @@ TEST q(Data::Dumper->new([$a,$b],['a','b
#$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 @@ TEST q(Data::Dumper->new([$a,$b],['a','b
#$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 @@ TEST q(Data::Dumper->new([$a,$b,$c],['a'
#$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 @@ TEST q(Data::Dumper->new([$a,$b,$c],['a'
#];
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 @@ TEST q(Data::Dumper->new([$a,$b,$c],['a'
#];
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 @@ TEST q(Data::Dumper->new([$b],['b'])->Pu
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
#};
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 @@ TEST q(Data::Dumper->new([$a])->Dumpxs;)
#};
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 @@ TEST q(Data::Dumper->new([$c])->Dumpxs;)
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 @@ TEST q(Data::Dumper->new([$c])->Dumpxs;)
#];
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 @@ EOT
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 @@ EOT
%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,8 @@ EOT
EOT
@foo = ();
$foo[2] = 1;
- TEST q(Data::Dumper->Dump([\@foo])), 'Richard Clamp, Message-Id: <20030104005247.GA27685@mirth.demon.co.uk>';
- TEST q(Data::Dumper->Dumpxs([\@foo])) if $XS;
+ TEST q(Data::Dumper->Dump([\@foo])), 'Richard Clamp, Message-Id: <20030104005247.GA27685@mirth.demon.co.uk>: Dump()';
+ TEST q(Data::Dumper->Dumpxs([\@foo])), 'Richard Clamp, Message-Id: <20030104005247.GA27685@mirth.demon.co.uk>: Dumpxs()'if $XS;
}
############# 364
@@ -1449,8 +1527,8 @@ EOT
$foo = [ join "", map chr, 0..255 ];
local $Data::Dumper::Useqq = 1;
- TEST q(Dumper($foo)), 'All latin1 characters';
- for (1..3) { print "not ok " . (++$TNUM) . " # TODO NYI\n" if $XS } # TEST q(Data::Dumper::DumperX($foo)) if $XS;
+ TEST (q(Dumper($foo)), 'All latin1 characters: Dumper');
+ TEST (q(Data::Dumper::DumperX($foo)), 'All latin1 characters: DumperX') if $XS;
}
############# 372
@@ -1468,40 +1546,49 @@ EOT
}
else {
TEST q(Dumper($foo)),
- 'All latin1 characters with utf8 flag including a wide character';
+ 'All latin1 characters with utf8 flag including a wide character: Dumper';
}
- for (1..3) { print "not ok " . (++$TNUM) . " # TODO NYI\n" if $XS } # TEST q(Data::Dumper::DumperX($foo)) if $XS;
+ 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.
- $WANT = $] > 5.0080001 ? $XS ? <<'EOT' : <<'EOV' : <<'EOU';
-#$a = \v65.66.67;
-#$b = \v65.66.067;
-#$c = \v65.66.6_7;
-#$d = \'ABC';
-EOT
-#$a = \v65.66.67;
-#$b = \v65.66.67;
-#$c = \v65.66.67;
-#$d = \'ABC';
-EOV
+ my $no_vstrings = <<'NOVSTRINGS';
#$a = \'ABC';
#$b = \'ABC';
#$c = \'ABC';
#$d = \'ABC';
-EOU
+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
);
- 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;
+ 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
@@ -1519,3 +1606,80 @@ EOW
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 -urp /tmp/mga3/perl/BUILD/perl-5.16.3/dist/Data-Dumper/t/perl-74170.t t/perl-74170.t
--- perl-5.16.3.orig/dist/Data-Dumper/t/perl-74170.t 2013-03-04 10:16:21.000000000 -0500
+++ perl-5.16.3/dist/Data-Dumper/t/perl-74170.t 2013-03-15 05:03:27.000000000 -0400
@@ -4,20 +4,20 @@
# Since it’s so large, it gets its own file.
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;
+ 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();
+our %repos = real_life_setup();
$Data::Dumper::Indent = 1;
# A custom sort sub is necessary for reproducing the bug, as this is where
@@ -25,13 +25,14 @@ $Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = sub { return [ reverse sort keys %{$_[0]} ]; }
unless exists $ENV{NO_SORT_SUB};
-ok +Data::Dumper->Dumpxs([\%repos], [qw(*repos)]);
+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
- # gitolite's "compiler" script:
+ # 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'} }, ();
@@ -140,4 +141,5 @@ sub real_life_setup {
$repos{''}{R}{'user8'} = 1;
$repos{''}{W}{'user8'} = 1;
push @{ $repos{''}{'user8'} }, ();
+ return %repos;
}
