This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.003: t/op/stat.t
[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 $
ae060272
PP
4# 950521 DFD This version hacked to make test 39 succeed on MachTen
5# though the O.S. wrongly thinks /dev/null is a terminal
378cc40b 6print "1..56\n";
8d063cd8 7
6eb13c3b
LW
8chop($cwd = `pwd`);
9
d48672a2
LW
10$DEV = `ls -l /dev`;
11
a687059c 12unlink "Op.stat.tmp";
f0fcb552 13open(FOO, ">Op.stat.tmp");
8d063cd8 14
988174c1
LW
15$junk = `ls Op.stat.tmp`; # hack to make Apollo update link count
16
8d063cd8 17($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
f0fcb552 18 $blksize,$blocks) = stat(FOO);
8d063cd8
LW
19if ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";}
20if ($mtime && $mtime == $ctime) {print "ok 2\n";} else {print "not ok 2\n";}
21
f0fcb552
LW
22print FOO "Now is the time for all good men to come to.\n";
23close(FOO);
8d063cd8 24
0d3e774c 25sleep 2;
8d063cd8
LW
26
27`rm -f Op.stat.tmp2; ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
28
29($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
30 $blksize,$blocks) = stat('Op.stat.tmp');
31
32if ($nlink == 2) {print "ok 3\n";} else {print "not ok 3\n";}
6eb13c3b
LW
33if (($mtime && $mtime != $ctime) || $cwd =~ m#/afs/#) {
34 print "ok 4\n";
35}
36else {
37 print "not ok 4\n";
4633a7c4
LW
38 print '#4 If test op/stat.t fails test 4, check if you are on a tmpfs';
39 print '#4 of some sort. Building in /tmp sometimes has this problem.';
6eb13c3b 40}
8d063cd8
LW
41print "#4 :$mtime: != :$ctime:\n";
42
988174c1
LW
43`rm -f Op.stat.tmp`;
44`touch Op.stat.tmp`;
378cc40b
LW
45
46if (-z 'Op.stat.tmp') {print "ok 5\n";} else {print "not ok 5\n";}
47if (! -s 'Op.stat.tmp') {print "ok 6\n";} else {print "not ok 6\n";}
48
49`echo hi >Op.stat.tmp`;
50if (! -z 'Op.stat.tmp') {print "ok 7\n";} else {print "not ok 7\n";}
51if (-s 'Op.stat.tmp') {print "ok 8\n";} else {print "not ok 8\n";}
52
fe14fcc3 53unlink 'Op.stat.tmp';
378cc40b 54$olduid = $>; # can't test -r if uid == 0
fe14fcc3
LW
55`echo hi >Op.stat.tmp`;
56chmod 0,'Op.stat.tmp';
378cc40b
LW
57eval '$> = 1;'; # so switch uid (may not be implemented)
58if (!$> || ! -r 'Op.stat.tmp') {print "ok 9\n";} else {print "not ok 9\n";}
59if (!$> || ! -w 'Op.stat.tmp') {print "ok 10\n";} else {print "not ok 10\n";}
60eval '$> = $olduid;'; # switch uid back (may not be implemented)
fe14fcc3 61print "# olduid=$olduid, newuid=$>\n" unless ($> == $olduid);
378cc40b
LW
62if (! -x 'Op.stat.tmp') {print "ok 11\n";} else {print "not ok 11\n";}
63
64foreach ((12,13,14,15,16,17)) {
65 print "ok $_\n"; #deleted tests
66}
67
68chmod 0700,'Op.stat.tmp';
69if (-r 'Op.stat.tmp') {print "ok 18\n";} else {print "not ok 18\n";}
70if (-w 'Op.stat.tmp') {print "ok 19\n";} else {print "not ok 19\n";}
71if (-x 'Op.stat.tmp') {print "ok 20\n";} else {print "not ok 20\n";}
72
73if (-f 'Op.stat.tmp') {print "ok 21\n";} else {print "not ok 21\n";}
74if (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";}
75
76if (-d '.') {print "ok 23\n";} else {print "not ok 23\n";}
77if (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";}
78
79if (`ls -l perl` =~ /^l.*->/) {
80 if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";}
81}
82else {
83 print "ok 25\n";
84}
85
86if (-o 'Op.stat.tmp') {print "ok 26\n";} else {print "not ok 26\n";}
87
88if (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";}
8d063cd8 89`rm -f Op.stat.tmp Op.stat.tmp2`;
378cc40b
LW
90if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";}
91
d48672a2
LW
92if ($DEV !~ /\nc.* (\S+)\n/)
93 {print "ok 29\n";}
94elsif (-c "/dev/$1")
95 {print "ok 29\n";}
96else
97 {print "not ok 29\n";}
378cc40b
LW
98if (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";}
99
d48672a2
LW
100if ($DEV !~ /\ns.* (\S+)\n/)
101 {print "ok 31\n";}
102elsif (-S "/dev/$1")
378cc40b
LW
103 {print "ok 31\n";}
104else
105 {print "not ok 31\n";}
106if (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";}
107
d48672a2
LW
108if ($DEV !~ /\nb.* (\S+)\n/)
109 {print "ok 33\n";}
110elsif (-b "/dev/$1")
378cc40b
LW
111 {print "ok 33\n";}
112else
113 {print "not ok 33\n";}
114if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";}
115
116$cnt = $uid = 0;
117
fe14fcc3 118die "Can't run op/stat.t test 35 without pwd working" unless $cwd;
b8440792 119print ("not ok 35\n"), goto tty_test unless -d '/usr/bin';
ac58e20f 120chdir '/usr/bin' || die "Can't cd to /usr/bin";
d9d8d8de 121while (defined($_ = <*>)) {
378cc40b
LW
122 $cnt++;
123 $uid++ if -u;
124 last if $uid && $uid < $cnt;
125}
ac58e20f 126chdir $cwd || die "Can't cd back to $cwd";
378cc40b
LW
127
128# I suppose this is going to fail somewhere...
79072805
LW
129if ($uid > 0 && $uid < $cnt)
130 {print "ok 35\n";}
131else
b8440792
IZ
132 {print "not ok 35 \n# ($uid $cnt)\n";}
133
134tty_test:
378cc40b
LW
135
136unless (open(tty,"/dev/tty")) {
a687059c 137 print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n";
378cc40b
LW
138}
139if (-t tty) {print "ok 36\n";} else {print "not ok 36\n";}
140if (-c tty) {print "ok 37\n";} else {print "not ok 37\n";}
141close(tty);
142if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";}
143open(null,"/dev/null");
ae060272
PP
144if (! -t null || -e '/xenix' || -e '/MachTen')
145 {print "ok 39\n";} else {print "not ok 39\n";}
378cc40b
LW
146close(null);
147if (-t) {print "ok 40\n";} else {print "not ok 40\n";}
148
149# These aren't strictly "stat" calls, but so what?
150
fe14fcc3
LW
151if (-T 'op/stat.t') {print "ok 41\n";} else {print "not ok 41\n";}
152if (! -B 'op/stat.t') {print "ok 42\n";} else {print "not ok 42\n";}
378cc40b 153
b8440792
IZ
154if (-B './perl' || -B './perl.exe') {print "ok 43\n";} else {print "not ok 43\n";}
155if (! -T './perl' && ! -T './perl.exe') {print "ok 44\n";} else {print "not ok 44\n";}
378cc40b 156
f0fcb552
LW
157open(FOO,'op/stat.t');
158eval { -T FOO; };
159if ($@ =~ /not implemented/) {
160 print "# $@";
161 for (45 .. 54) {
162 print "ok $_\n";
163 }
164}
165else {
166 if (-T FOO) {print "ok 45\n";} else {print "not ok 45\n";}
167 if (! -B FOO) {print "ok 46\n";} else {print "not ok 46\n";}
168 $_ = <FOO>;
169 if (/perl/) {print "ok 47\n";} else {print "not ok 47\n";}
170 if (-T FOO) {print "ok 48\n";} else {print "not ok 48\n";}
171 if (! -B FOO) {print "ok 49\n";} else {print "not ok 49\n";}
172 close(FOO);
173
174 open(FOO,'op/stat.t');
175 $_ = <FOO>;
176 if (/perl/) {print "ok 50\n";} else {print "not ok 50\n";}
177 if (-T FOO) {print "ok 51\n";} else {print "not ok 51\n";}
178 if (! -B FOO) {print "ok 52\n";} else {print "not ok 52\n";}
179 seek(FOO,0,0);
180 if (-T FOO) {print "ok 53\n";} else {print "not ok 53\n";}
181 if (! -B FOO) {print "ok 54\n";} else {print "not ok 54\n";}
182}
183close(FOO);
378cc40b
LW
184
185if (-T '/dev/null') {print "ok 55\n";} else {print "not ok 55\n";}
186if (-B '/dev/null') {print "ok 56\n";} else {print "not ok 56\n";}