11 use Config qw( %Config );
12 use File::Temp qw( tempfile tempdir );
16 my (undef, $file) = tempfile();
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');
25 foreach ([dev => 'device number'],
26 [ino => 'inode number'],
27 [mode => 'file mode'],
28 [nlink => 'number of links'],
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
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");
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');
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');
61 for my $op (split //, "rwxoRWXOezsfdlpSbcugkMCA") {
62 if ($skip && $op =~ $skip) {
63 note("Not testing -A $desc_tail");
66 my $stat = $op eq 'l' ? $lstat : $stat;
67 for my $access ('', 'use filetest "access";') {
68 my ($warnings, $awarn, $vwarn, $rv);
70 ? "for -$op under use filetest 'access' $desc_tail"
71 : "for -$op $desc_tail";
73 local $SIG{__WARN__} = sub {
75 if ($w =~ /^File::stat ignores VMS ACLs/) {
77 } elsif ($w =~ /^File::stat ignores use filetest 'access'/) {
83 $rv = eval "$access; -$op \$stat";
85 is($@, '', "Overload succeeds $desc");
87 if ($^O eq "VMS" && $op =~ /[rwxRWX]/) {
88 is($vwarn, 1, "warning about VMS ACLs $desc");
90 is($rv, eval "-$op \$file", "correct overload $desc")
92 is($vwarn, undef, "no warnings about VMS ACLs $desc");
95 # 111640 - File::stat bogus index check in overload
96 if ($access && $op =~ /[rwxRXW]/) {
97 # these should all warn with filetest access
99 "produced the right warning $desc");
101 # -d and others shouldn't warn
102 is($awarn, undef, "should be no warning $desc")
105 is($warnings, undef, "no other warnings seen $desc");
110 foreach ([file => $file],
111 [dir => tempdir(CLEANUP => 1)]) {
112 my ($what, $pathname) = @$_;
113 test_X_ops($pathname, "for $what $pathname");
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");
122 chmod 0600, $pathname
123 or die "Can't restore permissions on $pathname to 0600";
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;
130 # Other tests running in parallel mean that $^X is read, updating its atime
131 test_X_ops($^X, "for $^X", qr/A/);
135 my $stat = File::stat::stat($file);
136 isa_ok($stat, 'File::stat', 'should build a stat object');
138 for (split //, "tTB") {
140 like( $@, qr/\Q-$_ is not implemented/, "-$_ overload fails" );
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');
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');
156 # VOS open() updates atime; ignore this error (posix-975).
159 $$stat3[8] = $$stat[8];
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';
165 main::skip("OS/2: inode number is not constant on os/2", 1) if $^O eq 'os2';
167 main::is_deeply($stat, $stat3, '... and must match normal stat');
172 skip "We can't check for FIFOs", 2 unless defined &Fcntl::S_ISFIFO;
173 skip "No pipes", 2 unless defined $Config{d_pipe};
175 or skip "Couldn't create a pipe: $!", 2;
176 skip "Built-in -p doesn't detect a pipe", 2 unless -p $rh;
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");
183 # Testing pretty much anything else is unportable.
188 # cperl-indent-level: 4
189 # indent-tabs-mode: nil
192 # ex: set ts=8 sts=4 sw=4 et: