summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
Diffstat (limited to 't')
-rwxr-xr-xt/lib/dumper.t127
-rwxr-xr-xt/op/groups.t2
-rwxr-xr-xt/op/lex_assign.t11
-rw-r--r--t/pragma/warn/regexec10
4 files changed, 123 insertions, 27 deletions
diff --git a/t/lib/dumper.t b/t/lib/dumper.t
index 70f8abeb9e..e3d339afd4 100755
--- a/t/lib/dumper.t
+++ b/t/lib/dumper.t
@@ -35,11 +35,11 @@ sub TEST {
if (defined &Data::Dumper::Dumpxs) {
print "### XS extension loaded, will run XS tests\n";
- $TMAX = 138; $XS = 1;
+ $TMAX = 162; $XS = 1;
}
else {
print "### XS extensions not loaded, will NOT run XS tests\n";
- $TMAX = 69; $XS = 0;
+ $TMAX = 86; $XS = 0;
}
print "1..$TMAX\n";
@@ -236,11 +236,11 @@ EOT
##
$WANT = <<'EOT';
#$VAR1 = {
-# "abc\000\efg" => "mno\000"
+# "abc\0'\efg" => "mno\0"
#};
EOT
-$foo = { "abc\000\efg" => "mno\000" };
+$foo = { "abc\000\'\efg" => "mno\000" };
{
local $Data::Dumper::Useqq = 1;
TEST q(Dumper($foo));
@@ -248,7 +248,7 @@ $foo = { "abc\000\efg" => "mno\000" };
$WANT = <<"EOT";
#\$VAR1 = {
-# 'abc\000\efg' => 'mno\000'
+# 'abc\0\\'\efg' => 'mno\0'
#};
EOT
@@ -450,8 +450,8 @@ EOT
# Second => \'Wags'
#);
#@dogs = (
-# $kennels{First},
-# $kennels{Second},
+# ${$kennels{First}},
+# ${$kennels{Second}},
# \%kennels
#);
#%mutts = %kennels;
@@ -489,8 +489,8 @@ EOT
# Second => \'Wags'
#);
#@dogs = (
-# $kennels{First},
-# $kennels{Second},
+# ${$kennels{First}},
+# ${$kennels{Second}},
# \%kennels
#);
#%mutts = %kennels;
@@ -566,8 +566,8 @@ EOT
{
-sub a { print "foo\n" }
-$c = [ \&a ];
+sub z { print "foo\n" }
+$c = [ \&z ];
############# 121
##
@@ -578,8 +578,8 @@ $c = [ \&a ];
#];
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
@@ -591,8 +591,8 @@ TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'b' => \&a})->Dumpxs;)
#];
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
@@ -604,8 +604,101 @@ TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'*b' => \&a})->Dumpxs;)
#);
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,
+# ''
+#);
+#$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 => ''
+# },
+# {
+# 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;
+}
diff --git a/t/op/groups.t b/t/op/groups.t
index 55cf4de4fb..b2e766336b 100755
--- a/t/op/groups.t
+++ b/t/op/groups.t
@@ -1,6 +1,6 @@
#!./perl
-$ENV{PATH} = '/bin:/usr/bin:/usr/ucb:/usr/xpg4/bin';
+$ENV{PATH} = '/usr/xpg4/bin:/bin:/usr/bin:/usr/ucb';
unless (($groups = `(id -Gn || groups) 2>/dev/null`) ne '') {
print "1..0\n";
diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t
index d35f39c2c3..845a314bf9 100755
--- a/t/op/lex_assign.t
+++ b/t/op/lex_assign.t
@@ -33,7 +33,8 @@ for (@INPUT) {
$op = "$op==$op" unless $op =~ /==/;
($op, $expectop) = $op =~ /(.*)==(.*)/;
- $skip = ($op =~ /^'\?\?\?'/) ? "skip" : "not";
+ $skip = ($op =~ /^'\?\?\?'/ or $comment =~ /skip\(.*\Q$^O\E.*\)/i)
+ ? "skip" : "not";
$integer = ($comment =~ /^i_/) ? "use integer" : '' ;
(print "#skipping $comment:\nok $ord\n"), next if $skip eq 'skip';
@@ -61,8 +62,8 @@ EOE
__END__
ref $xref # ref
ref $cstr # ref nonref
-`ls` # backtick
-`$undefed` # backtick undef
+`ls` # backtick skip(MSWin32)
+`$undefed` # backtick undef skip(MSWin32)
<*> # glob
<OP> # readline
'faked' # rcatline
@@ -186,9 +187,9 @@ readlink 'non-existent', 'non-existent1' # readlink
'???' # fork
'???' # wait
'???' # waitpid
-system 'sh -c true' # system
+system "$^X -e 0" # system
'???' # exec
-kill 0, $$ # kill
+'???' # kill
getppid # getppid
getpgrp # getpgrp
'???' # setpgrp
diff --git a/t/pragma/warn/regexec b/t/pragma/warn/regexec
index 7c44e3efc1..6d4ec320e7 100644
--- a/t/pragma/warn/regexec
+++ b/t/pragma/warn/regexec
@@ -1,5 +1,9 @@
regexec.c
+ This test generates "bad free" warnings when run under
+ PERL_DESTRUCT_LEVEL. This file merely serves as a placeholder
+ for investigation.
+
Complex regular subexpression recursion limit (%d) exceeded
$_ = 'a' x (2**15+1); /^()(a\1)*$/ ;
@@ -11,12 +15,11 @@
REG_INFTY configuration variable value does not affect outcome.)
__END__
# regexec.c
+print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
use warning 'unsafe' ;
$SIG{__WARN__} = sub{local ($m) = shift;
$m =~ s/\(\d+\)/(*MASKED*)/;
print STDERR $m};
-print("SKIPPED\n# win32 can't increase stacksize in shell\n"),exit
- if $^O eq 'MSWin32';
$_ = 'a' x (2**15+1);
/^()(a\1)*$/ ;
#
@@ -38,12 +41,11 @@ EXPECT
Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9.
########
# regexec.c
+print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
use warning 'unsafe' ;
$SIG{__WARN__} = sub{local ($m) = shift;
$m =~ s/\(\d+\)/(*MASKED*)/;
print STDERR $m};
-print("SKIPPED\n# win32 can't increase stacksize in shell\n"),exit
- if $^O eq 'MSWin32';
$_ = 'a' x (2**15+1);
/^()(a\1)*?$/ ;
#
View Lorry Controller Status