1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
#!./perl
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
use Test::More;
use Config qw( %Config );
BEGIN {
# Check whether the build is configured with -Dmksymlinks
our $Dmksymlinks =
grep { /^config_arg\d+$/ && $Config{$_} eq '-Dmksymlinks' }
keys %Config;
# Resolve symlink to ./lib/File/stat.t if this build is configured
# with -Dmksymlinks
# Originally we worked with ./TEST, but other test scripts read from
# that file and modify its access time.
our $file = '../lib/File/stat.t';
if ( $Dmksymlinks ) {
$file = readlink $file;
die "Can't readlink(../lib/File/stat.t): $!" if ! defined $file;
}
our $hasst;
eval { my @n = stat $file };
$hasst = 1 unless $@ && $@ =~ /unimplemented/;
unless ($hasst) { plan skip_all => "no stat"; exit 0 }
use Config;
$hasst = 0 unless $Config{'i_sysstat'} eq 'define';
unless ($hasst) { plan skip_all => "no sys/stat.h"; exit 0 }
}
# Originally this was done in the BEGIN block, but perl is still
# compiling (and hence reading) the script at that point, which can
# change the file's access time, causing a different in the comparison
# tests if the clock ticked over the second between the stat() and the
# final read.
# At this point all of the reading is done.
our @stat = stat $file; # This is the function stat.
unless (@stat) { plan skip_all => "1..0 # Skip: no file $file"; exit 0 }
plan tests => 19 + 24*2 + 4 + 3;
use_ok( 'File::stat' );
my $stat = File::stat::stat( $file ); # This is the OO stat.
ok( ref($stat), 'should build a stat object' );
is( $stat->dev, $stat[0], "device number in position 0" );
# On OS/2 (fake) ino is not constant, it is incremented each time
SKIP: {
skip('inode number is not constant on OS/2', 1) if $^O eq 'os2';
is( $stat->ino, $stat[1], "inode number in position 1" );
}
is( $stat->mode, $stat[2], "file mode in position 2" );
is( $stat->nlink, $stat[3], "number of links in position 3" );
is( $stat->uid, $stat[4], "owner uid in position 4" );
is( $stat->gid, $stat[5], "group id in position 5" );
is( $stat->rdev, $stat[6], "device identifier in position 6" );
is( $stat->size, $stat[7], "file size in position 7" );
is( $stat->atime, $stat[8], "last access time in position 8" );
is( $stat->mtime, $stat[9], "last modify time in position 9" );
is( $stat->ctime, $stat[10], "change time in position 10" );
is( $stat->blksize, $stat[11], "IO block size in position 11" );
is( $stat->blocks, $stat[12], "number of blocks in position 12" );
for (split //, "rwxoRWXOezsfdlpSbcugkMCA") {
SKIP: {
$^O eq "VMS" and index("rwxRWX", $_) >= 0
and skip "File::stat ignores VMS ACLs", 2;
my $rv = eval "-$_ \$stat";
ok( !$@, "-$_ overload succeeds" )
or diag( $@ );
is( $rv, eval "-$_ \$file", "correct -$_ overload" );
}
}
SKIP: {
my $file = '../perl';
-e $file && -x $file or skip "$file is not present and exectable", 4;
$^O eq "VMS" and skip "File::stat ignores VMS ACLs", 4;
my $stat = File::stat::stat( $file ); # This is the OO stat.
foreach (qw/x X/) {
my $rv = eval "-$_ \$stat";
ok( !$@, "-$_ overload succeeds" )
or diag( $@ );
is( $rv, eval "-$_ \$file", "correct -$_ overload" );
}
}
for (split //, "tTB") {
eval "-$_ \$stat";
like( $@, qr/\Q-$_ is not implemented/, "-$_ overload fails" );
}
SKIP: {
local *STAT;
skip("Could not open file: $!", 2) unless open(STAT, $file);
ok( File::stat::stat('STAT'), '... should be able to find filehandle' );
package foo;
local *STAT = *main::STAT;
main::ok( my $stat2 = File::stat::stat('STAT'),
'... and filehandle in another package' );
close STAT;
# VOS open() updates atime; ignore this error (posix-975).
my $stat3 = $stat2;
if ($^O eq 'vos') {
$$stat3[8] = $$stat[8];
}
main::skip("Win32: different stat-info on filehandle", 1) if $^O eq 'MSWin32';
main::skip("dos: inode number is fake on dos", 1) if $^O eq 'dos';
main::skip("OS/2: inode number is not constant on os/2", 1) if $^O eq 'os2';
main::is( "@$stat", "@$stat3", '... and must match normal stat' );
}
local $!;
$stat = stat '/notafile';
isnt( $!, '', 'should populate $!, given invalid file' );
# Testing pretty much anything else is unportable.
|
