Commit | Line | Data |
---|---|---|
15b7a6a8 | 1 | #!./perl |
f7a45afb JH |
2 | |
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | } | |
7 | ||
d219c4fb NC |
8 | use strict; |
9 | use warnings; | |
2f173a71 | 10 | use Test::More; |
61a7d4fd | 11 | use Config qw( %Config ); |
81a201f4 | 12 | use File::Temp qw( tempfile tempdir ); |
c69df70f | 13 | |
ff4803d9 | 14 | use File::stat; |
f7a45afb | 15 | |
17c017a5 | 16 | my (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'); | |
ff4803d9 | 22 | is_deeply($stat, \@stat, '... and matches the builtin'); |
cf23dc19 NC |
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"); | |
db8b1169 | 44 | } |
cf23dc19 NC |
45 | ++$i; |
46 | } | |
ff4803d9 NC |
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'); | |
cf23dc19 | 52 | } |
db8b1169 | 53 | |
cf23dc19 | 54 | sub test_X_ops { |
a3eb442d | 55 | my ($file, $desc_tail, $skip) = @_; |
cf23dc19 NC |
56 | my @stat = CORE::stat $file; |
57 | my $stat = File::stat::stat($file); | |
c6cec307 | 58 | my $lstat = File::stat::lstat($file); |
cf23dc19 NC |
59 | isa_ok($stat, 'File::stat', 'should build a stat object'); |
60 | ||
61 | for my $op (split //, "rwxoRWXOezsfdlpSbcugkMCA") { | |
a3eb442d NC |
62 | if ($skip && $op =~ $skip) { |
63 | note("Not testing -A $desc_tail"); | |
64 | next; | |
65 | } | |
c6cec307 | 66 | my $stat = $op eq 'l' ? $lstat : $stat; |
cf23dc19 NC |
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"); | |
db8b1169 | 106 | } |
cd22a09c BM |
107 | } |
108 | } | |
109 | ||
81a201f4 NC |
110 | foreach ([file => $file], |
111 | [dir => tempdir(CLEANUP => 1)]) { | |
112 | my ($what, $pathname) = @$_; | |
113 | test_X_ops($pathname, "for $what $pathname"); | |
cf23dc19 | 114 | |
b050b2f8 NC |
115 | my $mode = 01000; |
116 | while ($mode) { | |
117 | $mode >>= 1; | |
118 | my $mode_oct = sprintf "0%03o", $mode; | |
81a201f4 NC |
119 | chmod $mode, $pathname or die "Can't chmod $mode_oct $pathname: $!"; |
120 | test_X_ops($pathname, "for $what with mode=$mode_oct"); | |
b050b2f8 | 121 | } |
81a201f4 NC |
122 | chmod 0600, $pathname |
123 | or die "Can't restore permissions on $pathname to 0600"; | |
b050b2f8 NC |
124 | } |
125 | ||
3c1f5943 | 126 | SKIP: { |
cf23dc19 | 127 | -e $^X && -x $^X or skip "$^X is not present and executable", 4; |
3c1f5943 TR |
128 | $^O eq "VMS" and skip "File::stat ignores VMS ACLs", 4; |
129 | ||
a3eb442d NC |
130 | # Other tests running in parallel mean that $^X is read, updating its atime |
131 | test_X_ops($^X, "for $^X", qr/A/); | |
3c1f5943 TR |
132 | } |
133 | ||
134 | ||
cf23dc19 NC |
135 | my $stat = File::stat::stat($file); |
136 | isa_ok($stat, 'File::stat', 'should build a stat object'); | |
137 | ||
cd22a09c BM |
138 | for (split //, "tTB") { |
139 | eval "-$_ \$stat"; | |
140 | like( $@, qr/\Q-$_ is not implemented/, "-$_ overload fails" ); | |
141 | } | |
142 | ||
83716b1e | 143 | SKIP: { |
144 | local *STAT; | |
61a7d4fd | 145 | skip("Could not open file: $!", 2) unless open(STAT, $file); |
cf23dc19 NC |
146 | isa_ok(File::stat::stat('STAT'), 'File::stat', |
147 | '... should be able to find filehandle'); | |
83716b1e | 148 | |
149 | package foo; | |
150 | local *STAT = *main::STAT; | |
cf23dc19 NC |
151 | my $stat2 = File::stat::stat('STAT'); |
152 | main::isa_ok($stat2, 'File::stat', | |
153 | '... and filehandle in another package'); | |
83716b1e | 154 | close STAT; |
155 | ||
659293e7 PG |
156 | # VOS open() updates atime; ignore this error (posix-975). |
157 | my $stat3 = $stat2; | |
158 | if ($^O eq 'vos') { | |
159 | $$stat3[8] = $$stat[8]; | |
160 | } | |
161 | ||
378bd967 | 162 | main::skip("Win32: different stat-info on filehandle", 1) if $^O eq 'MSWin32'; |
afdf87ad | 163 | main::skip("dos: inode number is fake on dos", 1) if $^O eq 'dos'; |
378bd967 | 164 | |
d51a9dd5 JH |
165 | main::skip("OS/2: inode number is not constant on os/2", 1) if $^O eq 'os2'; |
166 | ||
cf23dc19 | 167 | main::is_deeply($stat, $stat3, '... and must match normal stat'); |
83716b1e | 168 | } |
169 | ||
e0b1616f TC |
170 | SKIP: |
171 | { # RT #111638 | |
172 | skip "We can't check for FIFOs", 2 unless defined &Fcntl::S_ISFIFO; | |
173 | skip "No pipes", 2 unless defined $Config{d_pipe}; | |
174 | pipe my ($rh, $wh) | |
175 | or skip "Couldn't create a pipe: $!", 2; | |
176 | skip "Built-in -p doesn't detect a pipe", 2 unless -p $rh; | |
177 | ||
178 | my $pstat = File::stat::stat($rh); | |
179 | ok(!-p($stat), "-p should be false on a file"); | |
e0b1616f TC |
180 | ok(-p($pstat), "check -p detects a pipe"); |
181 | } | |
182 | ||
f7a45afb | 183 | # Testing pretty much anything else is unportable. |
c239c67c NC |
184 | |
185 | done_testing; | |
186 | ||
187 | # Local variables: | |
188 | # cperl-indent-level: 4 | |
189 | # indent-tabs-mode: nil | |
190 | # End: | |
191 | # | |
192 | # ex: set ts=8 sts=4 sw=4 et: |