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