@INC = '../lib';
}
+use strict;
+use warnings;
use Test::More;
use Config qw( %Config );
-
-BEGIN {
- # Check whether the build is configured with -Dmksymlinks
- our $Dmksymlinks =
- grep { /^config_arg\d+$/ && $Config{$_} eq '-Dmksymlinks' }
- keys %Config;
-
- # Resolve symlink to ./TEST if this build is configured with -Dmksymlinks
- our $file = 'TEST';
- if ( $Dmksymlinks ) {
- $file = readlink $file;
- die "Can't readlink(TEST): $!" if ! defined $file;
+use File::Temp qw( tempfile tempdir );
+
+use File::stat;
+
+my (undef, $file) = tempfile();
+
+{
+ my @stat = CORE::stat $file;
+ my $stat = File::stat::stat($file);
+ isa_ok($stat, 'File::stat', 'should build a stat object');
+ is_deeply($stat, \@stat, '... and matches the builtin');
+
+ 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;
}
- 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 }
- our @stat = stat $file; # This is the function stat.
- unless (@stat) { plan skip_all => "1..0 # Skip: no file $file"; exit 0 }
+ my $stat2 = stat $file;
+ isa_ok($stat2, 'File::stat',
+ 'File::stat exports stat, overriding the builtin');
+ is_deeply($stat2, $stat, '... and matches the direct call');
}
-plan tests => 19 + 24*2 + 3;
-
-use_ok( 'File::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" );
+sub test_X_ops {
+ my ($file, $desc_tail, $skip) = @_;
+ my @stat = CORE::stat $file;
+ my $stat = File::stat::stat($file);
+ my $lstat = File::stat::lstat($file);
+ isa_ok($stat, 'File::stat', 'should build a stat object');
+
+ for my $op (split //, "rwxoRWXOezsfdlpSbcugkMCA") {
+ if ($skip && $op =~ $skip) {
+ note("Not testing -A $desc_tail");
+ next;
+ }
+ my $stat = $op eq 'l' ? $lstat : $stat;
+ for my $access ('', 'use filetest "access";') {
+ my ($warnings, $awarn, $vwarn, $rv);
+ my $desc = $access
+ ? "for -$op under use filetest 'access' $desc_tail"
+ : "for -$op $desc_tail";
+ {
+ 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");
+ }
+ }
}
-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" );
+foreach ([file => $file],
+ [dir => tempdir(CLEANUP => 1)]) {
+ my ($what, $pathname) = @$_;
+ test_X_ops($pathname, "for $what $pathname");
-is( $stat->size, $stat[7], "file size in position 7" );
+ my $orig_mode = (CORE::stat $pathname)[2];
-is( $stat->atime, $stat[8], "last access time in position 8" );
-
-is( $stat->mtime, $stat[9], "last modify time in position 9" );
+ my $mode = 01000;
+ while ($mode) {
+ $mode >>= 1;
+ my $mode_oct = sprintf "0%03o", $mode;
+ chmod $mode, $pathname or die "Can't chmod $mode_oct $pathname: $!";
+ test_X_ops($pathname, "for $what with mode=$mode_oct");
+ }
+ chmod $orig_mode, $pathname
+ or die "Can't restore permissions on $pathname to ", sprintf("%#o", $orig_mode);
+}
-is( $stat->ctime, $stat[10], "change time in position 10" );
+SKIP: {
+ -e $^X && -x $^X or skip "$^X is not present and executable", 4;
+ $^O eq "VMS" and skip "File::stat ignores VMS ACLs", 4;
-is( $stat->blksize, $stat[11], "IO block size in position 11" );
+ # Other tests running in parallel mean that $^X is read, updating its atime
+ test_X_ops($^X, "for $^X", qr/A/);
+}
-is( $stat->blocks, $stat[12], "number of blocks in position 12" );
-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" );
- }
-}
+my $stat = File::stat::stat($file);
+isa_ok($stat, 'File::stat', 'should build a stat object');
for (split //, "tTB") {
eval "-$_ \$stat";
SKIP: {
local *STAT;
skip("Could not open file: $!", 2) unless open(STAT, $file);
- ok( File::stat::stat('STAT'), '... should be able to find filehandle' );
+ isa_ok(File::stat::stat('STAT'), 'File::stat',
+ '... should be able to find filehandle');
package foo;
local *STAT = *main::STAT;
- main::ok( my $stat2 = File::stat::stat('STAT'),
- '... and filehandle in another package' );
+ my $stat2 = File::stat::stat('STAT');
+ main::isa_ok($stat2, 'File::stat',
+ '... and filehandle in another package');
close STAT;
# VOS open() updates atime; ignore this error (posix-975).
main::skip("OS/2: inode number is not constant on os/2", 1) if $^O eq 'os2';
- main::is( "@$stat", "@$stat3", '... and must match normal stat' );
+ main::is_deeply($stat, $stat3, '... and must match normal stat');
}
-
-local $!;
-$stat = stat '/notafile';
-isnt( $!, '', 'should populate $!, given invalid file' );
+SKIP:
+{ # RT #111638
+ skip "We can't check for FIFOs", 2 unless defined &Fcntl::S_ISFIFO;
+ skip "No pipes", 2 unless defined $Config{d_pipe};
+ pipe my ($rh, $wh)
+ or skip "Couldn't create a pipe: $!", 2;
+ skip "Built-in -p doesn't detect a pipe", 2 unless -p $rh;
+
+ my $pstat = File::stat::stat($rh);
+ ok(!-p($stat), "-p should be false on a file");
+ ok(-p($pstat), "check -p detects a pipe");
+}
# Testing pretty much anything else is unportable.
+
+done_testing;
+
+# Local variables:
+# cperl-indent-level: 4
+# indent-tabs-mode: nil
+# End:
+#
+# ex: set ts=8 sts=4 sw=4 et:
https://perl5.git.perl.org / perl5.git / blobdiff