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
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 'tempfile';
13
14 require 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
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");
43         }
44         ++$i;
45     }
46 }
47
48 sub 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");
94         }
95     }
96 }
97
98 test_X_ops($file, "for $file");
99
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
111 SKIP: {
112     -e $^X && -x $^X or skip "$^X is not present and executable", 4;
113     $^O eq "VMS" and skip "File::stat ignores VMS ACLs", 4;
114
115     test_X_ops($^X, "for $^X");
116 }
117
118
119 my $stat = File::stat::stat($file);
120 isa_ok($stat, 'File::stat', 'should build a stat object');
121
122 for (split //, "tTB") {
123     eval "-$_ \$stat";
124     like( $@, qr/\Q-$_ is not implemented/, "-$_ overload fails" );
125 }
126
127 SKIP: {
128         local *STAT;
129         skip("Could not open file: $!", 2) unless open(STAT, $file);
130         isa_ok(File::stat::stat('STAT'), 'File::stat',
131                '... should be able to find filehandle');
132
133         package foo;
134         local *STAT = *main::STAT;
135         my $stat2 = File::stat::stat('STAT');
136         main::isa_ok($stat2, 'File::stat',
137                      '... and filehandle in another package');
138         close STAT;
139
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
146         main::skip("Win32: different stat-info on filehandle", 1) if $^O eq 'MSWin32';
147         main::skip("dos: inode number is fake on dos", 1) if $^O eq 'dos';
148
149         main::skip("OS/2: inode number is not constant on os/2", 1) if $^O eq 'os2';
150
151         main::is_deeply($stat, $stat3, '... and must match normal stat');
152 }
153
154 SKIP:
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");
164     ok(-p($pstat), "check -p detects a pipe");
165 }
166
167 # Testing pretty much anything else is unportable.
168
169 done_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: