lib/File/stat.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 use strict;
   9 use warnings;
  10 use Test::More;
  11 use Config qw( %Config );
  12 use File::Temp qw( tempfile tempdir );
  13
  14 use File::stat;
  15
  16 my (undef, $file) = tempfile(UNLINK => 1);
  17
  18 {
  19     my @stat = CORE::stat $file;
  20     my $stat = File::stat::stat($file);
  21     isa_ok($stat, 'File::stat', 'should build a stat object');
  22     is_deeply($stat, \@stat, '... and matches the builtin');
  23
  24     my $i = 0;
  25     foreach ([dev => 'device number'],
  26              [ino => 'inode number'],
  27              [mode => 'file mode'],
  28              [nlink => 'number of links'],
  29              [uid => 'owner uid'],
  30              [gid => 'group id'],
  31              [rdev => 'device identifier'],
  32              [size => 'file size'],
  33              [atime => 'last access time'],
  34              [mtime => 'last modify time'],
  35              [ctime => 'change time'],
  36              [blksize => 'IO block size'],
  37              [blocks => 'number of blocks']) {
  38         my ($meth, $desc) = @$_;
  39         # On OS/2 (fake) ino is not constant, it is incremented each time
  40     SKIP: {
  41             skip('inode number is not constant on OS/2', 1)
  42                 if $i == 1 && $^O eq 'os2';
  43             is($stat->$meth, $stat[$i], "$desc in position $i");
  44         }
  45         ++$i;
  46     }
  47
  48     my $stat2 = stat $file;
  49     isa_ok($stat2, 'File::stat',
  50            'File::stat exports stat, overriding the builtin');
  51     is_deeply($stat2, $stat, '... and matches the direct call');
  52 }
  53
  54 sub test_X_ops {
  55     my ($file, $desc_tail, $skip) = @_;
  56     my @stat = CORE::stat $file;
  57     my $stat = File::stat::stat($file);
  58     my $lstat = File::stat::lstat($file);
  59     isa_ok($stat, 'File::stat', 'should build a stat object');
  60
  61     for my $op (split //, "rwxoRWXOezsfdlpSbcugkMCA") {
  62         if ($skip && $op =~ $skip) {
  63             note("Not testing -A $desc_tail");
  64             next;
  65         }
  66         my $stat = $op eq 'l' ? $lstat : $stat;
  67         for my $access ('', 'use filetest "access";') {
  68             my ($warnings, $awarn, $vwarn, $rv);
  69             my $desc = $access
  70                 ? "for -$op under use filetest 'access' $desc_tail"
  71                     : "for -$op $desc_tail";
  72             {
  73                 local $SIG{__WARN__} = sub {
  74                     my $w = shift;
  75                     if ($w =~ /^File::stat ignores VMS ACLs/) {
  76                         ++$vwarn;
  77                     } elsif ($w =~ /^File::stat ignores use filetest 'access'/) {
  78                         ++$awarn;
  79                     } else {
  80                         $warnings .= $w;
  81                     }
  82                 };
  83                 $rv = eval "$access; -$op \$stat";
  84             }
  85             is($@, '', "Overload succeeds $desc");
  86
  87             if ($^O eq "VMS" && $op =~ /[rwxRWX]/) {
  88                 is($vwarn, 1, "warning about VMS ACLs $desc");
  89             } else {
  90                 is($rv, eval "-$op \$file", "correct overload $desc")
  91                     unless $access;
  92                 is($vwarn, undef, "no warnings about VMS ACLs $desc");
  93             }
  94
  95             # 111640 - File::stat bogus index check in overload
  96             if ($access && $op =~ /[rwxRXW]/) {
  97                 # these should all warn with filetest access
  98                 is($awarn, 1,
  99                    "produced the right warning $desc");
 100             } else {
 101                 # -d and others shouldn't warn
 102                 is($awarn, undef, "should be no warning $desc")
 103             }
 104
 105             is($warnings, undef, "no other warnings seen $desc");
 106         }
 107     }
 108 }
 109
 110 foreach ([file => $file],
 111          [dir => tempdir(CLEANUP => 1)]) {
 112     my ($what, $pathname) = @$_;
 113     test_X_ops($pathname, "for $what $pathname");
 114
 115     my $orig_mode = (CORE::stat $pathname)[2];
 116
 117     my $mode = 01000;
 118     while ($mode) {
 119         $mode >>= 1;
 120         my $mode_oct = sprintf "0%03o", $mode;
 121         chmod $mode, $pathname or die "Can't chmod $mode_oct $pathname: $!";
 122         test_X_ops($pathname, "for $what with mode=$mode_oct");
 123     }
 124     chmod $orig_mode, $pathname
 125         or die "Can't restore permissions on $pathname to ", sprintf("%#o", $orig_mode);
 126 }
 127
 128 SKIP: {
 129     -e $^X && -x $^X or skip "$^X is not present and executable", 4;
 130     $^O eq "VMS" and skip "File::stat ignores VMS ACLs", 4;
 131
 132     # Other tests running in parallel mean that $^X is read, updating its atime
 133     test_X_ops($^X, "for $^X", qr/A/);
 134 }
 135
 136
 137 my $stat = File::stat::stat($file);
 138 isa_ok($stat, 'File::stat', 'should build a stat object');
 139
 140 for (split //, "tTB") {
 141     eval "-$_ \$stat";
 142     like( $@, qr/\Q-$_ is not implemented/, "-$_ overload fails" );
 143 }
 144
 145 SKIP: {
 146         local *STAT;
 147         skip("Could not open file: $!", 2) unless open(STAT, '<', $file);
 148         isa_ok(File::stat::stat('STAT'), 'File::stat',
 149                '... should be able to find filehandle');
 150
 151         package foo;
 152         local *STAT = *main::STAT;
 153         my $stat2 = File::stat::stat('STAT');
 154         main::isa_ok($stat2, 'File::stat',
 155                      '... and filehandle in another package');
 156         close STAT;
 157
 158 #       VOS open() updates atime; ignore this error (posix-975).
 159         my $stat3 = $stat2;
 160         if ($^O eq 'vos') {
 161                 $$stat3[8] = $$stat[8];
 162         }
 163
 164         main::skip("Win32: different stat-info on filehandle", 1) if $^O eq 'MSWin32';
 165         main::skip("dos: inode number is fake on dos", 1) if $^O eq 'dos';
 166
 167         main::skip("OS/2: inode number is not constant on os/2", 1) if $^O eq 'os2';
 168
 169         main::is_deeply($stat, $stat3, '... and must match normal stat');
 170 }
 171
 172 SKIP:
 173 {   # RT #111638
 174     skip "We can't check for FIFOs", 2 unless defined &Fcntl::S_ISFIFO;
 175     skip "No pipes", 2 unless defined $Config{d_pipe};
 176     pipe my ($rh, $wh)
 177       or skip "Couldn't create a pipe: $!", 2;
 178     skip "Built-in -p doesn't detect a pipe", 2 unless -p $rh;
 179
 180     my $pstat = File::stat::stat($rh);
 181     ok(!-p($stat), "-p should be false on a file");
 182     ok(-p($pstat), "check -p detects a pipe");
 183 }
 184
 185 # Testing pretty much anything else is unportable.
 186
 187 done_testing;
 188
 189 # ex: set ts=8 sts=4 sw=4 et: