In perl.git, the branch smoke-me/File-stat has been updated <http://perl5.git.perl.org/perl.git/commitdiff/90186154858d662901d8c32aa865a0c71868f073?hp=8b02cf248f2584ba87dda62d49ce9d0db9877b8d>
- Log ----------------------------------------------------------------- commit 90186154858d662901d8c32aa865a0c71868f073 Author: Nicholas Clark <[email protected]> Date: Sun Jun 3 13:26:31 2012 +0200 Simplify lib/File/stat.t by using a tempfile as the test victim. The previous code had got very gnarly trying to use a file from the distribution for the test file, attempting to cope with 1) Other programs reading the file and hence the atime updating 2) The perl interpreter reading the file and hence the atime updating :-) 3) Building with -Dmksymlinks meaning that the file is a symlink All these problems and work arounds simply *vanish* if we use a tempfile. This will also enable us to change its mode in the future for better testing. Also, take advantage of the fact that Test::More::plan() will exit immediately itself if given a 'skip_all', to simplify some of the skip conditions. If stat isn't unimplemented (which causes skip_all), check that the trial stat didn't generate any error, and don't skip if we can't stat our tempfile (as that would be an error, not a brush-it-under-the-carpet). M lib/File/stat.t commit 6a33288ee0a46236bcb3f384ee43c9ab46c75c5c Author: Nicholas Clark <[email protected]> Date: Sun Jun 3 12:45:24 2012 +0200 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. M lib/File/stat.t commit 7b901446b9532032bb373445892ea5c44a5e7436 Author: Nicholas Clark <[email protected]> Date: Sun Jun 3 11:42:20 2012 +0200 Bring the joy of strict (and warnings) to lib/File/stat.t M lib/File/stat.t commit 2ca5b772a428905e361085e9546cdd3dbd138f1c Author: Nicholas Clark <[email protected]> Date: Sat Jun 2 22:51:14 2012 +0200 Replace repetitive code in lib/File/stat.t with a data driven loop. M lib/File/stat.t commit 0ea716a1e6313b991f4d009b7c24ea26c558cb5d Author: Nicholas Clark <[email protected]> Date: Sat Jun 2 22:42:47 2012 +0200 Convert lib/File/stat.t from a complex plan calculation to done_testing(). Also replace use_ok (not in BEGIN) with a simple require. If the require fails it's not worth trying to test anything else, Test::More's END handing will automatically report a test failure, so the failure will be recorded. M lib/File/stat.t ----------------------------------------------------------------------- Summary of changes: lib/File/stat.t | 170 ++++++++++++++++++++++++------------------------------- 1 files changed, 75 insertions(+), 95 deletions(-) diff --git a/lib/File/stat.t b/lib/File/stat.t index 78d57d8..8e231b8 100644 --- a/lib/File/stat.t +++ b/lib/File/stat.t @@ -5,89 +5,90 @@ BEGIN { @INC = '../lib'; } +use strict; +use warnings; use Test::More; use Config qw( %Config ); +use File::Temp 'tempfile'; -BEGIN { - # Check whether the build is configured with -Dmksymlinks - our $Dmksymlinks = - grep { /^config_arg\d+$/ && $Config{$_} eq '-Dmksymlinks' } - keys %Config; - - # Resolve symlink to ./lib/File/stat.t if this build is configured - # with -Dmksymlinks - # Originally we worked with ./TEST, but other test scripts read from - # that file and modify its access time. - our $file = '../lib/File/stat.t'; - if ( $Dmksymlinks ) { - $file = readlink $file; - die "Can't readlink(../lib/File/stat.t): $!" if ! defined $file; - } - - our $hasst; - eval { my @n = stat $file }; - $hasst = 1 unless $@ && $@ =~ /unimplemented/; - unless ($hasst) { plan skip_all => "no stat"; exit 0 } - use Config; - $hasst = 0 unless $Config{'i_sysstat'} eq 'define'; - unless ($hasst) { plan skip_all => "no sys/stat.h"; exit 0 } -} +plan(skip_all => "no sys/stat.h") + unless $Config{i_sysstat}; -# Originally this was done in the BEGIN block, but perl is still -# compiling (and hence reading) the script at that point, which can -# change the file's access time, causing a different in the comparison -# tests if the clock ticked over the second between the stat() and the -# final read. -# At this point all of the reading is done. -our @stat = stat $file; # This is the function stat. -unless (@stat) { plan skip_all => "1..0 # Skip: no file $file"; exit 0 } +my (undef, $file) = tempfile(); +eval { my @n = stat $file }; +plan(skip_all => "no stat") + if $@ && $@ =~ /unimplemented/; +is($@, '', "Can stat $file"); -plan tests => 19 + 24*2 + 4 + 3 + 7 + 2; - -use_ok( 'File::stat' ); +require File::stat; +my @stat = stat $file; # This is the function stat. my $stat = File::stat::stat( $file ); # This is the OO stat. -ok( ref($stat), 'should build a stat object' ); - -is( $stat->dev, $stat[0], "device number in position 0" ); - -# On OS/2 (fake) ino is not constant, it is incremented each time -SKIP: { - skip('inode number is not constant on OS/2', 1) if $^O eq 'os2'; - is( $stat->ino, $stat[1], "inode number in position 1" ); +isa_ok($stat, 'File::stat', 'should build a stat object' ); + +my $i = 0; +foreach ([dev => 'device number'], + [ino => 'inode number'], + [mode => 'file mode'], + [nlink => 'number of links'], + [uid => 'owner uid'], + [gid => 'group id'], + [rdev => 'device identifier'], + [size => 'file size'], + [atime => 'last access time'], + [mtime => 'last modify time'], + [ctime => 'change time'], + [blksize => 'IO block size'], + [blocks => 'number of blocks']) { + my ($meth, $desc) = @$_; + # On OS/2 (fake) ino is not constant, it is incremented each time + SKIP: { + skip('inode number is not constant on OS/2', 1) + if $i == 1 && $^O eq 'os2'; + is($stat->$meth, $stat[$i], "$desc in position $i"); + } + ++$i; } -is( $stat->mode, $stat[2], "file mode in position 2" ); - -is( $stat->nlink, $stat[3], "number of links in position 3" ); - -is( $stat->uid, $stat[4], "owner uid in position 4" ); - -is( $stat->gid, $stat[5], "group id in position 5" ); - -is( $stat->rdev, $stat[6], "device identifier in position 6" ); - -is( $stat->size, $stat[7], "file size in position 7" ); - -is( $stat->atime, $stat[8], "last access time in position 8" ); - -is( $stat->mtime, $stat[9], "last modify time in position 9" ); - -is( $stat->ctime, $stat[10], "change time in position 10" ); - -is( $stat->blksize, $stat[11], "IO block size in position 11" ); - -is( $stat->blocks, $stat[12], "number of blocks in position 12" ); +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"); + } -for (split //, "rwxoRWXOezsfdlpSbcugkMCA") { - SKIP: { - $^O eq "VMS" and index("rwxRWX", $_) >= 0 - and skip "File::stat ignores VMS ACLs", 2; + # 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") + } - my $rv = eval "-$_ \$stat"; - ok( !$@, "-$_ overload succeeds" ) - or diag( $@ ); - is( $rv, eval "-$_ \$file", "correct -$_ overload" ); + is($warnings, undef, "no other warnings seen $desc"); } } @@ -136,29 +137,6 @@ SKIP: { main::is( "@$stat", "@$stat3", '... and must match normal stat' ); } -{ # 111640 - File::stat bogus index check in overload - # 7 tests in this block - - use filetest "access"; - use warnings; - 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; @@ -177,3 +155,5 @@ $stat = stat '/notafile'; isnt( $!, '', 'should populate $!, given invalid file' ); # Testing pretty much anything else is unportable. + +done_testing; -- Perl5 Master Repository
