This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
b85ff95462cbf565df47d38b03c061a67a55a6af
[perl5.git] / 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();
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 $mode = 01000;
116     while ($mode) {
117         $mode >>= 1;
118         my $mode_oct = sprintf "0%03o", $mode;
119         chmod $mode, $pathname or die "Can't chmod $mode_oct $pathname: $!";
120         test_X_ops($pathname, "for $what with mode=$mode_oct");
121     }
122     chmod 0600, $pathname
123         or die "Can't restore permissions on $pathname to 0600";
124 }
125
126 SKIP: {
127     -e $^X && -x $^X or skip "$^X is not present and executable", 4;
128     $^O eq "VMS" and skip "File::stat ignores VMS ACLs", 4;
129
130     # Other tests running in parallel mean that $^X is read, updating its atime
131     test_X_ops($^X, "for $^X", qr/A/);
132 }
133
134
135 my $stat = File::stat::stat($file);
136 isa_ok($stat, 'File::stat', 'should build a stat object');
137
138 for (split //, "tTB") {
139     eval "-$_ \$stat";
140     like( $@, qr/\Q-$_ is not implemented/, "-$_ overload fails" );
141 }
142
143 SKIP: {
144         local *STAT;
145         skip("Could not open file: $!", 2) unless open(STAT, $file);
146         isa_ok(File::stat::stat('STAT'), 'File::stat',
147                '... should be able to find filehandle');
148
149         package foo;
150         local *STAT = *main::STAT;
151         my $stat2 = File::stat::stat('STAT');
152         main::isa_ok($stat2, 'File::stat',
153                      '... and filehandle in another package');
154         close STAT;
155
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
162         main::skip("Win32: different stat-info on filehandle", 1) if $^O eq 'MSWin32';
163         main::skip("dos: inode number is fake on dos", 1) if $^O eq 'dos';
164
165         main::skip("OS/2: inode number is not constant on os/2", 1) if $^O eq 'os2';
166
167         main::is_deeply($stat, $stat3, '... and must match normal stat');
168 }
169
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");
180     ok(-p($pstat), "check -p detects a pipe");
181 }
182
183 # Testing pretty much anything else is unportable.
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: