This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
The op/stat.t patch in #5341 wasn't robust enough,
[perl5.git] / t / op / stat.t
CommitLineData
8d063cd8
LW
1#!./perl
2
79072805 3# $RCSfile: stat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:28 $
ea368a7c
CS
4
5BEGIN {
6 chdir 't' if -d 't';
93430cb4 7 unshift @INC, '../lib';
ea368a7c
CS
8}
9
10use Config;
11
108ed793 12print "1..58\n";
8d063cd8 13
68dc0745 14$Is_MSWin32 = $^O eq 'MSWin32';
39e571d4 15$Is_Dos = $^O eq 'dos';
d493b042 16$Is_Dosish = $Is_Dos || $^O eq 'os2' || $Is_MSWin32;
4fabb596 17$Is_Cygwin = $^O eq 'cygwin';
68dc0745 18chop($cwd = ($Is_MSWin32 ? `cd` : `pwd`));
6eb13c3b 19
d702ae42 20$DEV = `ls -l /dev` unless $Is_Dosish or $Is_Cygwin;
d48672a2 21
a687059c 22unlink "Op.stat.tmp";
4435c477
IZ
23if (open(FOO, ">Op.stat.tmp")) {
24 # hack to make Apollo update link count:
25 $junk = `ls Op.stat.tmp` unless ($Is_MSWin32 || $Is_Dos);
26
27 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
28 $blksize,$blocks) = stat(FOO);
29 if ($nlink == 1) {
30 print "ok 1\n";
31 }
32 else {
33 print "# res=$res, nlink=$nlink.\nnot ok 1\n";
34 }
5db16f6a 35 if ($Is_MSWin32 or $Is_Cygwin || ($mtime && $mtime == $ctime)) {
4435c477
IZ
36 print "ok 2\n";
37 }
38 else {
39 print "# |$mtime| vs |$ctime|\nnot ok 2\n";
40 }
41
8d220878
JH
42 my $funky_FAT_timestamps = $Is_Cygwin;
43
44 sleep 3 if $funky_FAT_timestamps;
45
4435c477
IZ
46 print FOO "Now is the time for all good men to come to.\n";
47 close(FOO);
48
8d220878
JH
49 sleep 2 unless $funky_FAT_timestamps;
50
4435c477
IZ
51} else {
52 print "# open failed: $!\nnot ok 1\nnot ok 2\n";
53}
8d063cd8 54
4435c477 55if ($Is_Dosish) { unlink "Op.stat.tmp2"}
3fe9a6f1 56else {
57 `rm -f Op.stat.tmp2;ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
58}
8d063cd8
LW
59
60($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
61 $blksize,$blocks) = stat('Op.stat.tmp');
62
a245ea2d
IZ
63if ($Is_Dosish || $Config{dont_use_nlink})
64 {print "ok 3 # skipped: no link count\n";}
65elsif ($nlink == 2)
66 {print "ok 3\n";}
67else {print "# \$nlink is |$nlink|\nnot ok 3\n";}
ea368a7c 68
a245ea2d 69if ( $Is_Dosish
8d220878
JH
70 # Solaris tmpfs bug
71 || ($cwd =~ m#^/tmp# and $mtime && $mtime==$ctime && $^O eq 'solaris')
9b599b2a
GS
72 || $cwd =~ m#/afs/#
73 || $^O eq 'amigaos') {
a245ea2d
IZ
74 print "ok 4 # skipped: different semantic of mtime/ctime\n";
75}
76elsif ( ($mtime && $mtime != $ctime) ) {
6eb13c3b
LW
77 print "ok 4\n";
78}
79else {
80 print "not ok 4\n";
5aabfad6 81 print "#4 If test op/stat.t fails test 4, check if you are on a tmpfs\n";
82 print "#4 of some sort. Building in /tmp sometimes has this problem.\n";
6eb13c3b 83}
9b599b2a 84print "#4 :$mtime: should != :$ctime:\n";
8d063cd8 85
4435c477 86unlink "Op.stat.tmp" or print "# unlink failed: $!\n";
3fe9a6f1 87if ($Is_MSWin32) { open F, '>Op.stat.tmp' and close F }
88else { `touch Op.stat.tmp` }
378cc40b
LW
89
90if (-z 'Op.stat.tmp') {print "ok 5\n";} else {print "not ok 5\n";}
91if (! -s 'Op.stat.tmp') {print "ok 6\n";} else {print "not ok 6\n";}
92
3fe9a6f1 93$Is_MSWin32 ? `cmd /c echo hi > Op.stat.tmp` : `echo hi >Op.stat.tmp`;
378cc40b
LW
94if (! -z 'Op.stat.tmp') {print "ok 7\n";} else {print "not ok 7\n";}
95if (-s 'Op.stat.tmp') {print "ok 8\n";} else {print "not ok 8\n";}
96
4435c477 97unlink 'Op.stat.tmp' or print "# unlink failed: $!\n";
378cc40b 98$olduid = $>; # can't test -r if uid == 0
3fe9a6f1 99$Is_MSWin32 ? `cmd /c echo hi > Op.stat.tmp` : `echo hi >Op.stat.tmp`;
fe14fcc3 100chmod 0,'Op.stat.tmp';
378cc40b 101eval '$> = 1;'; # so switch uid (may not be implemented)
39e571d4 102if (!$> || $Is_Dos || ! -r 'Op.stat.tmp') {print "ok 9\n";} else {print "not ok 9\n";}
378cc40b
LW
103if (!$> || ! -w 'Op.stat.tmp') {print "ok 10\n";} else {print "not ok 10\n";}
104eval '$> = $olduid;'; # switch uid back (may not be implemented)
fe14fcc3 105print "# olduid=$olduid, newuid=$>\n" unless ($> == $olduid);
3e3baf6d 106
67fbe06e
GS
107if (! -x 'Op.stat.tmp') {print "ok 11\n";}
108else {print "not ok 11\n";}
378cc40b
LW
109
110foreach ((12,13,14,15,16,17)) {
111 print "ok $_\n"; #deleted tests
112}
113
8736538c
AS
114# in ms windows, Op.stat.tmp inherits owner uid from directory
115# not sure about os/2, but chown is harmless anyway
4435c477 116eval { chown $>,'Op.stat.tmp'; 1 } or print "# $@" ;
378cc40b
LW
117chmod 0700,'Op.stat.tmp';
118if (-r 'Op.stat.tmp') {print "ok 18\n";} else {print "not ok 18\n";}
119if (-w 'Op.stat.tmp') {print "ok 19\n";} else {print "not ok 19\n";}
a245ea2d
IZ
120if ($Is_Dosish) {print "ok 20 # skipped: -x by extension\n";}
121elsif (-x 'Op.stat.tmp') {print "ok 20\n";}
122else {print "not ok 20\n";}
378cc40b
LW
123
124if (-f 'Op.stat.tmp') {print "ok 21\n";} else {print "not ok 21\n";}
125if (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";}
126
127if (-d '.') {print "ok 23\n";} else {print "not ok 23\n";}
128if (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";}
129
a245ea2d 130if (!$Is_Dosish and `ls -l perl` =~ /^l.*->/) {
378cc40b
LW
131 if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";}
132}
133else {
134 print "ok 25\n";
135}
136
137if (-o 'Op.stat.tmp') {print "ok 26\n";} else {print "not ok 26\n";}
138
139if (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";}
108ed793
SM
140unlink 'Op.stat.tmp2';
141if (! -e 'Op.stat.tmp2') {print "ok 28\n";} else {print "not ok 28\n";}
378cc40b 142
39e571d4 143if ($Is_MSWin32 || $Is_Dos)
68dc0745 144 {print "ok 29\n";}
145elsif ($DEV !~ /\nc.* (\S+)\n/)
d48672a2
LW
146 {print "ok 29\n";}
147elsif (-c "/dev/$1")
148 {print "ok 29\n";}
149else
150 {print "not ok 29\n";}
378cc40b
LW
151if (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";}
152
39e571d4 153if ($Is_MSWin32 || $Is_Dos)
68dc0745 154 {print "ok 31\n";}
155elsif ($DEV !~ /\ns.* (\S+)\n/)
d48672a2
LW
156 {print "ok 31\n";}
157elsif (-S "/dev/$1")
378cc40b
LW
158 {print "ok 31\n";}
159else
160 {print "not ok 31\n";}
161if (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";}
162
39e571d4 163if ($Is_MSWin32 || $Is_Dos)
68dc0745 164 {print "ok 33\n";}
165elsif ($DEV !~ /\nb.* (\S+)\n/)
d48672a2
LW
166 {print "ok 33\n";}
167elsif (-b "/dev/$1")
378cc40b
LW
168 {print "ok 33\n";}
169else
170 {print "not ok 33\n";}
171if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";}
172
0994c4d0 173if ($^O eq 'mpeix' or $^O eq 'amigaos' or $Is_Dosish or $Is_Cygwin) {
a245ea2d
IZ
174 print "ok 35 # skipped: no -u\n"; goto tty_test;
175}
b971f6e4 176
378cc40b
LW
177$cnt = $uid = 0;
178
fe14fcc3 179die "Can't run op/stat.t test 35 without pwd working" unless $cwd;
1bcfde30 180($bin) = grep {-d} ($^O eq 'machten' ? qw(/usr/bin /bin) : qw(/bin /usr/bin))
5f05dabc 181 or print ("not ok 35\n"), goto tty_test;
b971f6e4 182opendir BIN, $bin or die "Can't opendir $bin: $!";
183while (defined($_ = readdir BIN)) {
184 $_ = "$bin/$_";
378cc40b
LW
185 $cnt++;
186 $uid++ if -u;
187 last if $uid && $uid < $cnt;
188}
b971f6e4 189closedir BIN;
378cc40b
LW
190
191# I suppose this is going to fail somewhere...
79072805
LW
192if ($uid > 0 && $uid < $cnt)
193 {print "ok 35\n";}
194else
b8440792
IZ
195 {print "not ok 35 \n# ($uid $cnt)\n";}
196
197tty_test:
378cc40b 198
3e3baf6d
TB
199# To assist in automated testing when a controlling terminal (/dev/tty)
200# may not be available (at, cron rsh etc), the PERL_SKIP_TTY_TEST env var
201# can be set to skip the tests that need a tty.
202unless($ENV{PERL_SKIP_TTY_TEST}) {
203 if ($Is_MSWin32) {
204 print "ok 36\n";
205 print "ok 37\n";
206 }
207 else {
8f1f23e8
W
208 my $TTY = "/dev/tty";
209
210 $TTY = "/dev/ttyp0" if $^O eq 'rhapsody';
211
212 if (defined $TTY) {
213 unless (open(TTY, $TTY)) {
214 print STDERR "Can't open $TTY--run t/TEST outside of make.\n";
215 }
216 if (-t TTY) {print "ok 36\n";} else {print "not ok 36\n";}
217 if (-c TTY) {print "ok 37\n";} else {print "not ok 37\n";}
218 close(TTY);
658e8587
JH
219 } else { # if some platform completely undefines $TTY
220 print "ok 36 # skipped\n";
221 print "ok 37 # skipped\n";
3e3baf6d 222 }
3e3baf6d 223 }
8f1f23e8 224 if (! -t TTY) {print "ok 38\n";} else {print "not ok 38\n";}
3e3baf6d 225 if (-t) {print "ok 39\n";} else {print "not ok 39\n";}
68dc0745 226}
227else {
3e3baf6d
TB
228 print "ok 36\n";
229 print "ok 37\n";
230 print "ok 38\n";
231 print "ok 39\n";
378cc40b 232}
378cc40b 233open(null,"/dev/null");
1bcfde30 234if (! -t null || -e '/xenix' || $^O eq 'machten' || $Is_MSWin32)
3e3baf6d 235 {print "ok 40\n";} else {print "not ok 40\n";}
378cc40b 236close(null);
378cc40b
LW
237
238# These aren't strictly "stat" calls, but so what?
239
fe14fcc3
LW
240if (-T 'op/stat.t') {print "ok 41\n";} else {print "not ok 41\n";}
241if (! -B 'op/stat.t') {print "ok 42\n";} else {print "not ok 42\n";}
378cc40b 242
b8440792
IZ
243if (-B './perl' || -B './perl.exe') {print "ok 43\n";} else {print "not ok 43\n";}
244if (! -T './perl' && ! -T './perl.exe') {print "ok 44\n";} else {print "not ok 44\n";}
378cc40b 245
f0fcb552
LW
246open(FOO,'op/stat.t');
247eval { -T FOO; };
248if ($@ =~ /not implemented/) {
249 print "# $@";
250 for (45 .. 54) {
251 print "ok $_\n";
252 }
253}
254else {
255 if (-T FOO) {print "ok 45\n";} else {print "not ok 45\n";}
256 if (! -B FOO) {print "ok 46\n";} else {print "not ok 46\n";}
257 $_ = <FOO>;
258 if (/perl/) {print "ok 47\n";} else {print "not ok 47\n";}
259 if (-T FOO) {print "ok 48\n";} else {print "not ok 48\n";}
260 if (! -B FOO) {print "ok 49\n";} else {print "not ok 49\n";}
261 close(FOO);
262
263 open(FOO,'op/stat.t');
264 $_ = <FOO>;
265 if (/perl/) {print "ok 50\n";} else {print "not ok 50\n";}
266 if (-T FOO) {print "ok 51\n";} else {print "not ok 51\n";}
267 if (! -B FOO) {print "ok 52\n";} else {print "not ok 52\n";}
268 seek(FOO,0,0);
269 if (-T FOO) {print "ok 53\n";} else {print "not ok 53\n";}
270 if (! -B FOO) {print "ok 54\n";} else {print "not ok 54\n";}
271}
272close(FOO);
378cc40b
LW
273
274if (-T '/dev/null') {print "ok 55\n";} else {print "not ok 55\n";}
275if (-B '/dev/null') {print "ok 56\n";} else {print "not ok 56\n";}
108ed793
SM
276
277# and now, a few parsing tests:
278$_ = 'Op.stat.tmp';
279if (-f) {print "ok 57\n";} else {print "not ok 57\n";}
280if (-f()) {print "ok 58\n";} else {print "not ok 58\n";}
281
4435c477 282unlink 'Op.stat.tmp' or print "# unlink failed: $!\n";