1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6} 7 8use strict; 9use warnings; 10use Test::More; 11use Config qw( %Config ); 12use File::Temp qw( tempfile tempdir ); 13 14use File::stat; 15 16my (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 54sub 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 SKIP : { 88 if ($^O eq "haiku" && $op =~ /A/) { 89 # atime is not stored on Haiku BFS 90 # and stat always returns local time instead 91 skip "testing -A $desc_tail on Haiku", 1; 92 } 93 94 if ($^O eq "VMS" && $op =~ /[rwxRWX]/) { 95 is($vwarn, 1, "warning about VMS ACLs $desc"); 96 } else { 97 is($rv, eval "-$op \$file", "correct overload $desc") 98 unless $access; 99 is($vwarn, undef, "no warnings about VMS ACLs $desc"); 100 } 101 } 102 103 # 111640 - File::stat bogus index check in overload 104 if ($access && $op =~ /[rwxRXW]/) { 105 # these should all warn with filetest access 106 is($awarn, 1, 107 "produced the right warning $desc"); 108 } else { 109 # -d and others shouldn't warn 110 is($awarn, undef, "should be no warning $desc") 111 } 112 113 is($warnings, undef, "no other warnings seen $desc"); 114 } 115 } 116} 117 118foreach ([file => $file], 119 [dir => tempdir(CLEANUP => 1)]) { 120 my ($what, $pathname) = @$_; 121 test_X_ops($pathname, "for $what $pathname"); 122 123 my $orig_mode = (CORE::stat $pathname)[2]; 124 125 my $mode = 01000; 126 while ($mode) { 127 $mode >>= 1; 128 my $mode_oct = sprintf "0%03o", $mode; 129 chmod $mode, $pathname or die "Can't chmod $mode_oct $pathname: $!"; 130 test_X_ops($pathname, "for $what with mode=$mode_oct"); 131 } 132 chmod $orig_mode, $pathname 133 or die "Can't restore permissions on $pathname to ", sprintf("%#o", $orig_mode); 134} 135 136SKIP: { 137 -e $^X && -x $^X or skip "$^X is not present and executable", 4; 138 $^O eq "VMS" and skip "File::stat ignores VMS ACLs", 4; 139 140 # Other tests running in parallel mean that $^X is read, updating its atime 141 test_X_ops($^X, "for $^X", qr/A/); 142} 143 144# open early so atime is consistent with the name based call 145local *STAT; 146my $canopen = open(STAT, '<', $file); 147 148my $stat = File::stat::stat($file); 149isa_ok($stat, 'File::stat', 'should build a stat object'); 150 151for (split //, "tTB") { 152 eval "-$_ \$stat"; 153 like( $@, qr/\Q-$_ is not implemented/, "-$_ overload fails" ); 154} 155 156SKIP: { 157 skip("Could not open file: $!", 2) unless $canopen; 158 isa_ok(File::stat::stat('STAT'), 'File::stat', 159 '... should be able to find filehandle'); 160 161 package foo; 162 local *STAT = *main::STAT; 163 my $stat2 = File::stat::stat('STAT'); 164 main::isa_ok($stat2, 'File::stat', 165 '... and filehandle in another package'); 166 close STAT; 167 168# VOS open() updates atime; ignore this error (posix-975). 169 my $stat3 = $stat2; 170 if ($^O eq 'vos') { 171 $$stat3[8] = $$stat[8]; 172 } 173 174 main::skip("Win32: different stat-info on filehandle", 1) if $^O eq 'MSWin32'; 175 176 main::skip("OS/2: inode number is not constant on os/2", 1) if $^O eq 'os2'; 177 178 main::is_deeply($stat, $stat3, '... and must match normal stat'); 179} 180 181SKIP: 182{ # RT #111638 183 skip "We can't check for FIFOs", 2 unless defined &Fcntl::S_ISFIFO; 184 skip "No pipes", 2 unless defined $Config{d_pipe}; 185 pipe my ($rh, $wh) 186 or skip "Couldn't create a pipe: $!", 2; 187 skip "Built-in -p doesn't detect a pipe", 2 unless -p $rh; 188 189 my $pstat = File::stat::stat($rh); 190 ok(!-p($stat), "-p should be false on a file"); 191 ok(-p($pstat), "check -p detects a pipe"); 192} 193 194# Testing pretty much anything else is unportable. 195 196done_testing; 197 198# ex: set ts=8 sts=4 sw=4 et: 199