diff options
author | Nicholas Clark <nick@ccl4.org> | 2012-06-03 12:45:24 +0200 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2012-06-21 08:58:59 +0200 |
commit | db8b11690af8b0c2b3e47e2608779a694309488d (patch) | |
tree | 3c2a7746231020c8f715deb47457f9579b8c349e /lib/File | |
parent | d219c4fb6438557254d9a1cd6c9a4ac5c59c977f (diff) | |
download | perl-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.t | 69 |
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; |