summaryrefslogtreecommitdiff
path: root/lib/File
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2012-06-03 12:45:24 +0200
committerNicholas Clark <nick@ccl4.org>2012-06-21 08:58:59 +0200
commitdb8b11690af8b0c2b3e47e2608779a694309488d (patch)
tree3c2a7746231020c8f715deb47457f9579b8c349e /lib/File
parentd219c4fb6438557254d9a1cd6c9a4ac5c59c977f (diff)
downloadperl-db8b11690af8b0c2b3e47e2608779a694309488d.tar.gz
In lib/File/stat.t, test everything with and without use filetest "access".
Previously the use filetest "access" tests were separate, and didn't test all the "should not warn" cases. By moving them into the main data-driven loop it's trivial to test everything. Also test that all the correct errors are seen on VMS, and not seen anywhere else.
Diffstat (limited to 'lib/File')
-rw-r--r--lib/File/stat.t69
1 files changed, 39 insertions, 30 deletions
diff --git a/lib/File/stat.t b/lib/File/stat.t
index eb8fdd0b94..b5157b81cb 100644
--- a/lib/File/stat.t
+++ b/lib/File/stat.t
@@ -75,15 +75,45 @@ foreach ([dev => 'device number'],
++$i;
}
-for (split //, "rwxoRWXOezsfdlpSbcugkMCA") {
- SKIP: {
- $^O eq "VMS" and index("rwxRWX", $_) >= 0
- and skip "File::stat ignores VMS ACLs", 2;
-
- my $rv = eval "-$_ \$stat";
- ok( !$@, "-$_ overload succeeds" )
- or diag( $@ );
- is( $rv, eval "-$_ \$file", "correct -$_ overload" );
+for my $op (split //, "rwxoRWXOezsfdlpSbcugkMCA") {
+ for my $access ('', 'use filetest "access";') {
+ my ($warnings, $awarn, $vwarn, $rv);
+ my $desc = $access
+ ? "for -$op under use filetest 'access'" : "for -$op";
+ {
+ local $SIG{__WARN__} = sub {
+ my $w = shift;
+ if ($w =~ /^File::stat ignores VMS ACLs/) {
+ ++$vwarn;
+ } elsif ($w =~ /^File::stat ignores use filetest 'access'/) {
+ ++$awarn;
+ } else {
+ $warnings .= $w;
+ }
+ };
+ $rv = eval "$access; -$op \$stat";
+ }
+ is($@, '', "Overload succeeds $desc");
+
+ if ($^O eq "VMS" && $op =~ /[rwxRWX]/) {
+ is($vwarn, 1, "warning about VMS ACLs $desc");
+ } else {
+ is($rv, eval "-$op \$file", "correct overload $desc")
+ unless $access;
+ is($vwarn, undef, "no warnings about VMS ACLs $desc");
+ }
+
+ # 111640 - File::stat bogus index check in overload
+ if ($access && $op =~ /[rwxRXW]/) {
+ # these should all warn with filetest access
+ is($awarn, 1,
+ "produced the right warning $desc");
+ } else {
+ # -d and others shouldn't warn
+ is($awarn, undef, "should be no warning $desc")
+ }
+
+ is($warnings, undef, "no other warnings seen $desc");
}
}
@@ -132,27 +162,6 @@ SKIP: {
main::is( "@$stat", "@$stat3", '... and must match normal stat' );
}
-{ # 111640 - File::stat bogus index check in overload
-
- use filetest "access";
- for my $op (split //, "rwxRXW") {
- # these should all warn with filetest access
- my $w;
- local $SIG{__WARN__} = sub { $w .= shift };
- eval "-$op \$stat";
- like($w, qr/^File::stat ignores use filetest 'access'/,
- "-$op produced the right warning under use filetest 'access'");
- }
-
- {
- # -d and others shouldn't warn
- my $w;
- local $SIG{__WARN__} = sub { $w = shift };
- eval '-d $stat';
- is($w, undef, "Should be no warning from -d under filetest access");
- }
-}
-
SKIP:
{ # RT #111638
skip "We can't check for FIFOs", 2 unless defined &Fcntl::S_ISFIFO;