BEGIN {
chdir 't' if -d 't';
- @INC = '../lib' if -d '../lib';
+ @INC = '../lib';
+ require Config; import Config;
+ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
+ print "1..0 # Skip: Data::Dumper was not built\n";
+ exit 0;
+ }
}
use Data::Dumper;
+use Config;
+my $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define';
$Data::Dumper::Pad = "#";
my $TMAX;
my $string = shift;
my $t = eval $string;
++$TNUM;
+ $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
+ 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;
+ }
print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
: "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
$t = eval $string;
++$TNUM;
+ $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
+ 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;
+ }
print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
: "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
}
if (defined &Data::Dumper::Dumpxs) {
print "### XS extension loaded, will run XS tests\n";
- $TMAX = 138; $XS = 1;
+ $TMAX = 186; $XS = 1;
}
else {
print "### XS extensions not loaded, will NOT run XS tests\n";
- $TMAX = 69; $XS = 0;
+ $TMAX = 93; $XS = 0;
}
print "1..$TMAX\n";
#$a = [
# 1,
# {
-# 'a' => $a,
-# 'b' => $a->[1],
# 'c' => [
# 'c'
-# ]
+# ],
+# 'a' => $a,
+# 'b' => $a->[1]
# },
# $a->[1]{'c'}
# ];
#@a = (
# 1,
# {
-# 'a' => [],
-# 'b' => {},
# 'c' => [
# 'c'
-# ]
+# ],
+# 'a' => [],
+# 'b' => {}
# },
# []
# );
##
$WANT = <<'EOT';
#%b = (
+# 'c' => [
+# 'c'
+# ],
# 'a' => [
# 1,
# {},
-# [
-# 'c'
-# ]
+# []
# ],
-# 'b' => {},
-# 'c' => []
+# 'b' => {}
# );
#$b{'a'}[1] = \%b;
+#$b{'a'}[2] = $b{'c'};
#$b{'b'} = \%b;
-#$b{'c'} = $b{'a'}[2];
#$a = $b{'a'};
EOT
#$a = [
# 1,
# {
+# 'c' => [],
# 'a' => [],
-# 'b' => {},
-# 'c' => []
+# 'b' => {}
# },
# []
#];
+#$a->[1]{'c'} = \@c;
#$a->[1]{'a'} = $a;
#$a->[1]{'b'} = $a->[1];
-#$a->[1]{'c'} = \@c;
#$a->[2] = \@c;
#$b = $a->[1];
EOT
# 1,
# #1
# {
-# a => $a,
-# b => $a->[1],
# c => [
# #0
# 'c'
-# ]
+# ],
+# a => $a,
+# b => $a->[1]
# },
# #2
# $a->[1]{c}
#$VAR1 = [
# 1,
# {
-# 'a' => [],
-# 'b' => {},
# 'c' => [
# 'c'
-# ]
+# ],
+# 'a' => [],
+# 'b' => {}
# },
# []
#];
#[
# 1,
# {
-# a => $VAR1,
-# b => $VAR1->[1],
# c => [
# 'c'
-# ]
+# ],
+# a => $VAR1,
+# b => $VAR1->[1]
# },
# $VAR1->[1]{c}
#]
##
$WANT = <<'EOT';
#$VAR1 = {
-# "abc\000\efg" => "mno\000"
+# "reftest" => \\1,
+# "abc\0'\efg" => "mno\0"
#};
EOT
-$foo = { "abc\000\efg" => "mno\000" };
+$foo = { "abc\000\'\efg" => "mno\000",
+ "reftest" => \\1,
+ };
{
local $Data::Dumper::Useqq = 1;
TEST q(Dumper($foo));
$WANT = <<"EOT";
#\$VAR1 = {
-# 'abc\000\efg' => 'mno\000'
+# 'reftest' => \\\\1,
+# 'abc\0\\'\efg' => 'mno\0'
#};
EOT
package main;
use Data::Dumper;
$foo = 5;
- @foo = (10,\*foo);
+ @foo = (-10,\*foo);
%foo = (a=>1,b=>\$foo,c=>\@foo);
$foo{d} = \%foo;
$foo[2] = \%foo;
#*::foo = \5;
#*::foo = [
# #0
-# 10,
+# -10,
# #1
-# '',
+# do{my $o},
# #2
# {
-# 'a' => 1,
-# 'b' => '',
# 'c' => [],
+# 'a' => 1,
+# 'b' => do{my $o},
# 'd' => {}
# }
# ];
#*::foo{ARRAY}->[1] = $foo;
-#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
+#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
#*::foo = *::foo{ARRAY}->[2];
#@bar = @{*::foo{ARRAY}};
#$foo = \*::foo;
#*::foo = \5;
#*::foo = [
-# 10,
-# '',
+# -10,
+# do{my $o},
# {
-# 'a' => 1,
-# 'b' => '',
# 'c' => [],
+# 'a' => 1,
+# 'b' => do{my $o},
# 'd' => {}
# }
#];
#*::foo{ARRAY}->[1] = $foo;
-#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
+#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
#*::foo = *::foo{ARRAY}->[2];
#$bar = *::foo{ARRAY};
##
$WANT = <<'EOT';
#@bar = (
-# 10,
+# -10,
# \*::foo,
# {}
#);
#*::foo = \5;
#*::foo = \@bar;
#*::foo = {
-# 'a' => 1,
-# 'b' => '',
# 'c' => [],
+# 'a' => 1,
+# 'b' => do{my $o},
# 'd' => {}
#};
-#*::foo{HASH}->{'b'} = *::foo{SCALAR};
#*::foo{HASH}->{'c'} = \@bar;
+#*::foo{HASH}->{'b'} = *::foo{SCALAR};
#*::foo{HASH}->{'d'} = *::foo{HASH};
#$bar[2] = *::foo{HASH};
#%baz = %{*::foo{HASH}};
##
$WANT = <<'EOT';
#$bar = [
-# 10,
+# -10,
# \*::foo,
# {}
#];
#*::foo = \5;
#*::foo = $bar;
#*::foo = {
-# 'a' => 1,
-# 'b' => '',
# 'c' => [],
+# 'a' => 1,
+# 'b' => do{my $o},
# 'd' => {}
#};
-#*::foo{HASH}->{'b'} = *::foo{SCALAR};
#*::foo{HASH}->{'c'} = $bar;
+#*::foo{HASH}->{'b'} = *::foo{SCALAR};
#*::foo{HASH}->{'d'} = *::foo{HASH};
#$bar->[2] = *::foo{HASH};
#$baz = *::foo{HASH};
$WANT = <<'EOT';
#$foo = \*::foo;
#@bar = (
-# 10,
+# -10,
# $foo,
# {
+# c => \@bar,
# a => 1,
# b => \5,
-# c => \@bar,
# d => $bar[2]
# }
#);
$WANT = <<'EOT';
#$foo = \*::foo;
#$bar = [
-# 10,
+# -10,
# $foo,
# {
+# c => $bar,
# a => 1,
# b => \5,
-# c => $bar,
# d => $bar->[2]
# }
#];
##
$WANT = <<'EOT';
#%kennels = (
-# First => \'Fido',
-# Second => \'Wags'
+# Second => \'Wags',
+# First => \'Fido'
#);
#@dogs = (
-# $kennels{First},
-# $kennels{Second},
+# ${$kennels{First}},
+# ${$kennels{Second}},
# \%kennels
#);
#%mutts = %kennels;
##
$WANT = <<'EOT';
#%kennels = (
-# First => \'Fido',
-# Second => \'Wags'
+# Second => \'Wags',
+# First => \'Fido'
#);
#@dogs = (
-# $kennels{First},
-# $kennels{Second},
+# ${$kennels{First}},
+# ${$kennels{Second}},
# \%kennels
#);
#%mutts = %kennels;
# 'Fido',
# 'Wags',
# {
-# First => \$dogs[0],
-# Second => \$dogs[1]
+# Second => \$dogs[1],
+# First => \$dogs[0]
# }
#);
#%kennels = %{$dogs[2]};
# 'Fido',
# 'Wags',
# {
-# First => \'Fido',
-# Second => \'Wags'
+# Second => \'Wags',
+# First => \'Fido'
# }
#);
#%kennels = (
-# First => \'Fido',
-# Second => \'Wags'
+# Second => \'Wags',
+# First => \'Fido'
#);
EOT
{
-sub a { print "foo\n" }
-$c = [ \&a ];
+sub z { print "foo\n" }
+$c = [ \&z ];
############# 121
##
#];
EOT
-TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'b' => \&a})->Dump;);
-TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'b' => \&a})->Dumpxs;)
+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;)
if $XS;
############# 127
#];
EOT
-TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'*b' => \&a})->Dump;);
-TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'*b' => \&a})->Dumpxs;)
+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;)
if $XS;
############# 133
#);
EOT
-TEST q(Data::Dumper->new([\&a,$c],['*a','*c'])->Seen({'*b' => \&a})->Dump;);
-TEST q(Data::Dumper->new([\&a,$c],['*a','*c'])->Seen({'*b' => \&a})->Dumpxs;)
+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;)
+ if $XS;
+
+}
+
+{
+ $a = [];
+ $a->[1] = \$a->[0];
+
+############# 139
+##
+ $WANT = <<'EOT';
+#@a = (
+# undef,
+# do{my $o}
+#);
+#$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;)
+ if $XS;
+}
+
+{
+ $a = \\\\\'foo';
+ $b = $$$a;
+
+############# 145
+##
+ $WANT = <<'EOT';
+#$a = \\\\\'foo';
+#$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;)
if $XS;
+}
+{
+ $a = [{ a => \$b }, { b => undef }];
+ $b = [{ c => \$b }, { d => \$a }];
+
+############# 151
+##
+ $WANT = <<'EOT';
+#$a = [
+# {
+# a => \[
+# {
+# c => do{my $o}
+# },
+# {
+# d => \[]
+# }
+# ]
+# },
+# {
+# b => undef
+# }
+#];
+#${$a->[0]{a}}->[0]->{c} = $a->[0]{a};
+#${${$a->[0]{a}}->[1]->{d}} = $a;
+#$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;)
+ if $XS;
+}
+
+{
+ $a = [[[[\\\\\'foo']]]];
+ $b = $a->[0][0];
+ $c = $${$b->[0][0]};
+
+############# 157
+##
+ $WANT = <<'EOT';
+#$a = [
+# [
+# [
+# [
+# \\\\\'foo'
+# ]
+# ]
+# ]
+#];
+#$b = $a->[0][0];
+#$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;)
+ if $XS;
+}
+
+{
+ $f = "pearl";
+ $e = [ $f ];
+ $d = { 'e' => $e };
+ $c = [ $d ];
+ $b = { 'c' => $c };
+ $a = { 'b' => $b };
+
+############# 163
+##
+ $WANT = <<'EOT';
+#$a = {
+# b => {
+# c => [
+# {
+# e => 'ARRAY(0xdeadbeef)'
+# }
+# ]
+# }
+#};
+#$b = $a->{b};
+#$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;)
+ if $XS;
+
+############# 169
+##
+ $WANT = <<'EOT';
+#$a = {
+# b => 'HASH(0xdeadbeef)'
+#};
+#$b = $a->{b};
+#$c = [
+# 'HASH(0xdeadbeef)'
+#];
+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;)
+ if $XS;
+}
+
+{
+ $a = \$a;
+ $b = [$a];
+
+############# 175
+##
+ $WANT = <<'EOT';
+#$b = [
+# \$b->[0]
+#];
+EOT
+
+TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dump;);
+TEST q(Data::Dumper->new([$b],['b'])->Purity(0)->Dumpxs;)
+ if $XS;
+
+############# 181
+##
+ $WANT = <<'EOT';
+#$b = [
+# \do{my $o}
+#];
+#${$b->[0]} = $b->[0];
+EOT
+
+
+TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dump;);
+TEST q(Data::Dumper->new([$b],['b'])->Purity(1)->Dumpxs;)
+ if $XS;
}