This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Replace repetitive code in lib/File/stat.t with a data driven loop.
[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
2f173a71 8use Test::More;
61a7d4fd 9use Config qw( %Config );
2f173a71 10
f7a45afb 11BEGIN {
61a7d4fd
JJ
12 # Check whether the build is configured with -Dmksymlinks
13 our $Dmksymlinks =
14 grep { /^config_arg\d+$/ && $Config{$_} eq '-Dmksymlinks' }
15 keys %Config;
16
c69df70f
TC
17 # Resolve symlink to ./lib/File/stat.t if this build is configured
18 # with -Dmksymlinks
19 # Originally we worked with ./TEST, but other test scripts read from
20 # that file and modify its access time.
ebcfa053 21 our $file = '../lib/File/stat.t';
61a7d4fd
JJ
22 if ( $Dmksymlinks ) {
23 $file = readlink $file;
3c1f5943 24 die "Can't readlink(../lib/File/stat.t): $!" if ! defined $file;
61a7d4fd
JJ
25 }
26
f7a45afb 27 our $hasst;
61a7d4fd 28 eval { my @n = stat $file };
f7a45afb 29 $hasst = 1 unless $@ && $@ =~ /unimplemented/;
2f173a71 30 unless ($hasst) { plan skip_all => "no stat"; exit 0 }
f7a45afb
JH
31 use Config;
32 $hasst = 0 unless $Config{'i_sysstat'} eq 'define';
2f173a71 33 unless ($hasst) { plan skip_all => "no sys/stat.h"; exit 0 }
f7a45afb
JH
34}
35
c69df70f
TC
36# Originally this was done in the BEGIN block, but perl is still
37# compiling (and hence reading) the script at that point, which can
38# change the file's access time, causing a different in the comparison
39# tests if the clock ticked over the second between the stat() and the
40# final read.
41# At this point all of the reading is done.
42our @stat = stat $file; # This is the function stat.
43unless (@stat) { plan skip_all => "1..0 # Skip: no file $file"; exit 0 }
44
c239c67c 45require File::stat;
f7a45afb 46
61a7d4fd 47my $stat = File::stat::stat( $file ); # This is the OO stat.
c239c67c 48isa_ok($stat, 'File::stat', 'should build a stat object' );
f7a45afb 49
e6c356cc
NC
50my $i = 0;
51foreach ([dev => 'device number'],
52 [ino => 'inode number'],
53 [mode => 'file mode'],
54 [nlink => 'number of links'],
55 [uid => 'owner uid'],
56 [gid => 'group id'],
57 [rdev => 'device identifier'],
58 [size => 'file size'],
59 [atime => 'last access time'],
60 [mtime => 'last modify time'],
61 [ctime => 'change time'],
62 [blksize => 'IO block size'],
63 [blocks => 'number of blocks']) {
64 my ($meth, $desc) = @$_;
65 # On OS/2 (fake) ino is not constant, it is incremented each time
66 SKIP: {
67 skip('inode number is not constant on OS/2', 1)
68 if $i == 1 && $^O eq 'os2';
69 is($stat->$meth, $stat[$i], "$desc in position $i");
70 }
71 ++$i;
2f173a71 72}
73
cd22a09c
BM
74for (split //, "rwxoRWXOezsfdlpSbcugkMCA") {
75 SKIP: {
e9fd6cc7
CB
76 $^O eq "VMS" and index("rwxRWX", $_) >= 0
77 and skip "File::stat ignores VMS ACLs", 2;
cd22a09c
BM
78
79 my $rv = eval "-$_ \$stat";
80 ok( !$@, "-$_ overload succeeds" )
81 or diag( $@ );
61a7d4fd 82 is( $rv, eval "-$_ \$file", "correct -$_ overload" );
cd22a09c
BM
83 }
84}
85
3c1f5943
TR
86SKIP: {
87 my $file = '../perl';
98dc9551 88 -e $file && -x $file or skip "$file is not present and executable", 4;
3c1f5943
TR
89 $^O eq "VMS" and skip "File::stat ignores VMS ACLs", 4;
90
91 my $stat = File::stat::stat( $file ); # This is the OO stat.
92 foreach (qw/x X/) {
93 my $rv = eval "-$_ \$stat";
94 ok( !$@, "-$_ overload succeeds" )
95 or diag( $@ );
96 is( $rv, eval "-$_ \$file", "correct -$_ overload" );
97 }
98}
99
100
cd22a09c
BM
101for (split //, "tTB") {
102 eval "-$_ \$stat";
103 like( $@, qr/\Q-$_ is not implemented/, "-$_ overload fails" );
104}
105
83716b1e 106SKIP: {
107 local *STAT;
61a7d4fd 108 skip("Could not open file: $!", 2) unless open(STAT, $file);
83716b1e 109 ok( File::stat::stat('STAT'), '... should be able to find filehandle' );
110
111 package foo;
112 local *STAT = *main::STAT;
113 main::ok( my $stat2 = File::stat::stat('STAT'),
114 '... and filehandle in another package' );
115 close STAT;
116
659293e7
PG
117# VOS open() updates atime; ignore this error (posix-975).
118 my $stat3 = $stat2;
119 if ($^O eq 'vos') {
120 $$stat3[8] = $$stat[8];
121 }
122
378bd967 123 main::skip("Win32: different stat-info on filehandle", 1) if $^O eq 'MSWin32';
afdf87ad 124 main::skip("dos: inode number is fake on dos", 1) if $^O eq 'dos';
378bd967 125
d51a9dd5
JH
126 main::skip("OS/2: inode number is not constant on os/2", 1) if $^O eq 'os2';
127
659293e7 128 main::is( "@$stat", "@$stat3", '... and must match normal stat' );
83716b1e 129}
130
606cb3b3 131{ # 111640 - File::stat bogus index check in overload
606cb3b3
TC
132
133 use filetest "access";
134 use warnings;
135 for my $op (split //, "rwxRXW") {
606cb3b3
TC
136 # these should all warn with filetest access
137 my $w;
39ce3d22 138 local $SIG{__WARN__} = sub { $w .= shift };
606cb3b3
TC
139 eval "-$op \$stat";
140 like($w, qr/^File::stat ignores use filetest 'access'/,
141 "-$op produced the right warning under use filetest 'access'");
142 }
143
144 {
606cb3b3
TC
145 # -d and others shouldn't warn
146 my $w;
147 local $SIG{__WARN__} = sub { $w = shift };
148 eval '-d $stat';
149 is($w, undef, "Should be no warning from -d under filetest access");
150 }
151}
cd22a09c 152
e0b1616f
TC
153SKIP:
154{ # RT #111638
155 skip "We can't check for FIFOs", 2 unless defined &Fcntl::S_ISFIFO;
156 skip "No pipes", 2 unless defined $Config{d_pipe};
157 pipe my ($rh, $wh)
158 or skip "Couldn't create a pipe: $!", 2;
159 skip "Built-in -p doesn't detect a pipe", 2 unless -p $rh;
160
161 my $pstat = File::stat::stat($rh);
162 ok(!-p($stat), "-p should be false on a file");
e0b1616f
TC
163 ok(-p($pstat), "check -p detects a pipe");
164}
165
2f173a71 166local $!;
167$stat = stat '/notafile';
cd22a09c 168isnt( $!, '', 'should populate $!, given invalid file' );
f7a45afb
JH
169
170# Testing pretty much anything else is unportable.
c239c67c
NC
171
172done_testing;
173
174# Local variables:
175# cperl-indent-level: 4
176# indent-tabs-mode: nil
177# End:
178#
179# ex: set ts=8 sts=4 sw=4 et: