This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In lib/File/stat.t, permute the test file's mode for more thorough testing.
[perl5.git] / lib / File / stat.t
CommitLineData
15b7a6a8 1#!./perl
f7a45afb
JH
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6}
7
d219c4fb
NC
8use strict;
9use warnings;
2f173a71 10use Test::More;
61a7d4fd 11use Config qw( %Config );
17c017a5 12use File::Temp 'tempfile';
c69df70f 13
c239c67c 14require File::stat;
f7a45afb 15
17c017a5 16my (undef, $file) = tempfile();
2f173a71 17
cf23dc19
NC
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
23 my $i = 0;
24 foreach ([dev => 'device number'],
25 [ino => 'inode number'],
26 [mode => 'file mode'],
27 [nlink => 'number of links'],
28 [uid => 'owner uid'],
29 [gid => 'group id'],
30 [rdev => 'device identifier'],
31 [size => 'file size'],
32 [atime => 'last access time'],
33 [mtime => 'last modify time'],
34 [ctime => 'change time'],
35 [blksize => 'IO block size'],
36 [blocks => 'number of blocks']) {
37 my ($meth, $desc) = @$_;
38 # On OS/2 (fake) ino is not constant, it is incremented each time
39 SKIP: {
40 skip('inode number is not constant on OS/2', 1)
41 if $i == 1 && $^O eq 'os2';
42 is($stat->$meth, $stat[$i], "$desc in position $i");
db8b1169 43 }
cf23dc19
NC
44 ++$i;
45 }
46}
db8b1169 47
cf23dc19
NC
48sub test_X_ops {
49 my ($file, $desc_tail) = @_;
50 my @stat = CORE::stat $file;
51 my $stat = File::stat::stat($file);
52 isa_ok($stat, 'File::stat', 'should build a stat object');
53
54 for my $op (split //, "rwxoRWXOezsfdlpSbcugkMCA") {
55 for my $access ('', 'use filetest "access";') {
56 my ($warnings, $awarn, $vwarn, $rv);
57 my $desc = $access
58 ? "for -$op under use filetest 'access' $desc_tail"
59 : "for -$op $desc_tail";
60 {
61 local $SIG{__WARN__} = sub {
62 my $w = shift;
63 if ($w =~ /^File::stat ignores VMS ACLs/) {
64 ++$vwarn;
65 } elsif ($w =~ /^File::stat ignores use filetest 'access'/) {
66 ++$awarn;
67 } else {
68 $warnings .= $w;
69 }
70 };
71 $rv = eval "$access; -$op \$stat";
72 }
73 is($@, '', "Overload succeeds $desc");
74
75 if ($^O eq "VMS" && $op =~ /[rwxRWX]/) {
76 is($vwarn, 1, "warning about VMS ACLs $desc");
77 } else {
78 is($rv, eval "-$op \$file", "correct overload $desc")
79 unless $access;
80 is($vwarn, undef, "no warnings about VMS ACLs $desc");
81 }
82
83 # 111640 - File::stat bogus index check in overload
84 if ($access && $op =~ /[rwxRXW]/) {
85 # these should all warn with filetest access
86 is($awarn, 1,
87 "produced the right warning $desc");
88 } else {
89 # -d and others shouldn't warn
90 is($awarn, undef, "should be no warning $desc")
91 }
92
93 is($warnings, undef, "no other warnings seen $desc");
db8b1169 94 }
cd22a09c
BM
95 }
96}
97
cf23dc19
NC
98test_X_ops($file, "for $file");
99
b050b2f8
NC
100{
101 my $mode = 01000;
102 while ($mode) {
103 $mode >>= 1;
104 my $mode_oct = sprintf "0%03o", $mode;
105 chmod $mode, $file or die "Can't chmod $mode_oct $file: $!";
106 test_X_ops($file, "for file with mode=$mode_oct");
107 }
108 chmod 0600, $file or die "Can't restore permissions on $file to 0600";
109}
110
3c1f5943 111SKIP: {
cf23dc19 112 -e $^X && -x $^X or skip "$^X is not present and executable", 4;
3c1f5943
TR
113 $^O eq "VMS" and skip "File::stat ignores VMS ACLs", 4;
114
cf23dc19 115 test_X_ops($^X, "for $^X");
3c1f5943
TR
116}
117
118
cf23dc19
NC
119my $stat = File::stat::stat($file);
120isa_ok($stat, 'File::stat', 'should build a stat object');
121
cd22a09c
BM
122for (split //, "tTB") {
123 eval "-$_ \$stat";
124 like( $@, qr/\Q-$_ is not implemented/, "-$_ overload fails" );
125}
126
83716b1e 127SKIP: {
128 local *STAT;
61a7d4fd 129 skip("Could not open file: $!", 2) unless open(STAT, $file);
cf23dc19
NC
130 isa_ok(File::stat::stat('STAT'), 'File::stat',
131 '... should be able to find filehandle');
83716b1e 132
133 package foo;
134 local *STAT = *main::STAT;
cf23dc19
NC
135 my $stat2 = File::stat::stat('STAT');
136 main::isa_ok($stat2, 'File::stat',
137 '... and filehandle in another package');
83716b1e 138 close STAT;
139
659293e7
PG
140# VOS open() updates atime; ignore this error (posix-975).
141 my $stat3 = $stat2;
142 if ($^O eq 'vos') {
143 $$stat3[8] = $$stat[8];
144 }
145
378bd967 146 main::skip("Win32: different stat-info on filehandle", 1) if $^O eq 'MSWin32';
afdf87ad 147 main::skip("dos: inode number is fake on dos", 1) if $^O eq 'dos';
378bd967 148
d51a9dd5
JH
149 main::skip("OS/2: inode number is not constant on os/2", 1) if $^O eq 'os2';
150
cf23dc19 151 main::is_deeply($stat, $stat3, '... and must match normal stat');
83716b1e 152}
153
e0b1616f
TC
154SKIP:
155{ # RT #111638
156 skip "We can't check for FIFOs", 2 unless defined &Fcntl::S_ISFIFO;
157 skip "No pipes", 2 unless defined $Config{d_pipe};
158 pipe my ($rh, $wh)
159 or skip "Couldn't create a pipe: $!", 2;
160 skip "Built-in -p doesn't detect a pipe", 2 unless -p $rh;
161
162 my $pstat = File::stat::stat($rh);
163 ok(!-p($stat), "-p should be false on a file");
e0b1616f
TC
164 ok(-p($pstat), "check -p detects a pipe");
165}
166
f7a45afb 167# Testing pretty much anything else is unportable.
c239c67c
NC
168
169done_testing;
170
171# Local variables:
172# cperl-indent-level: 4
173# indent-tabs-mode: nil
174# End:
175#
176# ex: set ts=8 sts=4 sw=4 et: