Commit | Line | Data |
3eb568f1 |
1 | #!./perl |
2 | |
9f1b1f2d |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
20822f61 |
5 | @INC = '../lib'; |
e620cd72 |
6 | } |
9f1b1f2d |
7 | |
e620cd72 |
8 | # $RCSfile$ |
853846ea |
9 | $| = 1; |
9f1b1f2d |
10 | use warnings; |
821b8a23 |
11 | $Is_VMS = $^O eq 'VMS'; |
a6c71b5b |
12 | $Is_Dos = $^O eq 'dos'; |
3eb568f1 |
13 | |
f6c77cf1 |
14 | print "1..70\n"; |
2c8ac474 |
15 | |
16 | my $test = 1; |
17 | |
18 | sub ok { print "ok $test\n"; $test++ } |
3eb568f1 |
19 | |
853846ea |
20 | # my $file tests |
21 | |
2c8ac474 |
22 | # 1..9 |
6170680b |
23 | { |
e620cd72 |
24 | unlink("afile") if -f "afile"; |
2c8ac474 |
25 | print "$!\nnot " unless open(my $f,"+>afile"); |
26 | ok; |
27 | binmode $f; |
e620cd72 |
28 | print "not " unless -f "afile"; |
2c8ac474 |
29 | ok; |
30 | print "not " unless print $f "SomeData\n"; |
31 | ok; |
32 | print "not " unless tell($f) == 9; |
33 | ok; |
34 | print "not " unless seek($f,0,0); |
35 | ok; |
36 | $b = <$f>; |
37 | print "not " unless $b eq "SomeData\n"; |
38 | ok; |
e620cd72 |
39 | print "not " unless -f $f; |
2c8ac474 |
40 | ok; |
e620cd72 |
41 | eval { die "Message" }; |
2c8ac474 |
42 | # warn $@; |
43 | print "not " unless $@ =~ /<\$f> line 1/; |
44 | ok; |
45 | print "not " unless close($f); |
46 | ok; |
e620cd72 |
47 | unlink("afile"); |
6170680b |
48 | } |
2c8ac474 |
49 | |
50 | # 10..12 |
6170680b |
51 | { |
2c8ac474 |
52 | print "# \$!='$!'\nnot " unless open(my $f,'>', 'afile'); |
53 | ok; |
54 | print $f "a row\n"; |
55 | print "not " unless close($f); |
56 | ok; |
57 | print "not " unless -s 'afile' < 10; |
58 | ok; |
6170680b |
59 | } |
2c8ac474 |
60 | |
61 | # 13..15 |
6170680b |
62 | { |
2c8ac474 |
63 | print "# \$!='$!'\nnot " unless open(my $f,'>>', 'afile'); |
64 | ok; |
65 | print $f "a row\n"; |
66 | print "not " unless close($f); |
67 | ok; |
68 | print "not " unless -s 'afile' > 10; |
69 | ok; |
6170680b |
70 | } |
2c8ac474 |
71 | |
72 | # 16..18 |
6170680b |
73 | { |
2c8ac474 |
74 | print "# \$!='$!'\nnot " unless open(my $f, '<', 'afile'); |
75 | ok; |
76 | @rows = <$f>; |
77 | print "not " unless @rows == 2; |
78 | ok; |
79 | print "not " unless close($f); |
80 | ok; |
6170680b |
81 | } |
2c8ac474 |
82 | |
83 | # 19..23 |
6170680b |
84 | { |
2c8ac474 |
85 | print "not " unless -s 'afile' < 20; |
86 | ok; |
87 | print "# \$!='$!'\nnot " unless open(my $f, '+<', 'afile'); |
88 | ok; |
89 | @rows = <$f>; |
90 | print "not " unless @rows == 2; |
91 | ok; |
92 | seek $f, 0, 1; |
93 | print $f "yet another row\n"; |
94 | print "not " unless close($f); |
95 | ok; |
96 | print "not " unless -s 'afile' > 20; |
97 | ok; |
98 | |
e620cd72 |
99 | unlink("afile"); |
2c8ac474 |
100 | } |
101 | |
102 | # 24..26 |
103 | if ($Is_VMS) { |
f0963acb |
104 | for (24..26) { print "ok $_ # skipped: not Unix fork\n"; $test++;} |
2c8ac474 |
105 | } |
821b8a23 |
106 | else { |
2c8ac474 |
107 | print "# \$!='$!'\nnot " unless open(my $f, '-|', <<'EOC'); |
108 | ./perl -e "print qq(a row\n); print qq(another row\n)" |
6170680b |
109 | EOC |
2c8ac474 |
110 | ok; |
111 | @rows = <$f>; |
112 | print "not " unless @rows == 2; |
113 | ok; |
114 | print "not " unless close($f); |
115 | ok; |
116 | } |
117 | |
118 | # 27..30 |
119 | if ($Is_VMS) { |
f0963acb |
120 | for (27..30) { print "ok $_ # skipped: not Unix fork\n"; $test++;} |
2c8ac474 |
121 | } |
821b8a23 |
122 | else { |
2c8ac474 |
123 | print "# \$!='$!'\nnot " unless open(my $f, '|-', <<'EOC'); |
124 | ./perl -pe "s/^not //" |
6170680b |
125 | EOC |
2c8ac474 |
126 | ok; |
127 | @rows = <$f>; |
128 | print $f "not ok $test\n"; $test++; |
129 | print $f "not ok $test\n"; $test++; |
130 | print "#\nnot " unless close($f); |
131 | sleep 1; |
132 | ok; |
6170680b |
133 | } |
3eb568f1 |
134 | |
2c8ac474 |
135 | # 31..32 |
6170680b |
136 | eval <<'EOE' and print "not "; |
137 | open my $f, '<&', 'afile'; |
138 | 1; |
139 | EOE |
2c8ac474 |
140 | ok; |
4fbc943a |
141 | $@ =~ /Bad filehandle:\s+afile/ or print "not "; |
2c8ac474 |
142 | ok; |
143 | |
144 | # local $file tests |
145 | |
146 | # 33..41 |
147 | { |
e620cd72 |
148 | unlink("afile") if -f "afile"; |
2c8ac474 |
149 | print "$!\nnot " unless open(local $f,"+>afile"); |
150 | ok; |
151 | binmode $f; |
e620cd72 |
152 | print "not " unless -f "afile"; |
2c8ac474 |
153 | ok; |
154 | print "not " unless print $f "SomeData\n"; |
155 | ok; |
156 | print "not " unless tell($f) == 9; |
157 | ok; |
158 | print "not " unless seek($f,0,0); |
159 | ok; |
160 | $b = <$f>; |
161 | print "not " unless $b eq "SomeData\n"; |
162 | ok; |
e620cd72 |
163 | print "not " unless -f $f; |
2c8ac474 |
164 | ok; |
e620cd72 |
165 | eval { die "Message" }; |
2c8ac474 |
166 | # warn $@; |
167 | print "not " unless $@ =~ /<\$f> line 1/; |
168 | ok; |
169 | print "not " unless close($f); |
170 | ok; |
e620cd72 |
171 | unlink("afile"); |
2c8ac474 |
172 | } |
173 | |
174 | # 42..44 |
175 | { |
176 | print "# \$!='$!'\nnot " unless open(local $f,'>', 'afile'); |
177 | ok; |
178 | print $f "a row\n"; |
179 | print "not " unless close($f); |
180 | ok; |
181 | print "not " unless -s 'afile' < 10; |
182 | ok; |
183 | } |
184 | |
185 | # 45..47 |
186 | { |
187 | print "# \$!='$!'\nnot " unless open(local $f,'>>', 'afile'); |
188 | ok; |
189 | print $f "a row\n"; |
190 | print "not " unless close($f); |
191 | ok; |
192 | print "not " unless -s 'afile' > 10; |
193 | ok; |
194 | } |
195 | |
196 | # 48..50 |
197 | { |
198 | print "# \$!='$!'\nnot " unless open(local $f, '<', 'afile'); |
199 | ok; |
200 | @rows = <$f>; |
201 | print "not " unless @rows == 2; |
202 | ok; |
203 | print "not " unless close($f); |
204 | ok; |
205 | } |
206 | |
207 | # 51..55 |
208 | { |
209 | print "not " unless -s 'afile' < 20; |
210 | ok; |
211 | print "# \$!='$!'\nnot " unless open(local $f, '+<', 'afile'); |
212 | ok; |
213 | @rows = <$f>; |
214 | print "not " unless @rows == 2; |
215 | ok; |
216 | seek $f, 0, 1; |
217 | print $f "yet another row\n"; |
218 | print "not " unless close($f); |
219 | ok; |
220 | print "not " unless -s 'afile' > 20; |
221 | ok; |
222 | |
e620cd72 |
223 | unlink("afile"); |
2c8ac474 |
224 | } |
225 | |
226 | # 56..58 |
227 | if ($Is_VMS) { |
f0963acb |
228 | for (56..58) { print "ok $_ # skipped: not Unix fork\n"; $test++;} |
2c8ac474 |
229 | } |
230 | else { |
231 | print "# \$!='$!'\nnot " unless open(local $f, '-|', <<'EOC'); |
232 | ./perl -e "print qq(a row\n); print qq(another row\n)" |
233 | EOC |
234 | ok; |
235 | @rows = <$f>; |
236 | print "not " unless @rows == 2; |
237 | ok; |
238 | print "not " unless close($f); |
239 | ok; |
240 | } |
241 | |
242 | # 59..62 |
243 | if ($Is_VMS) { |
f0963acb |
244 | for (59..62) { print "ok $_ # skipped: not Unix fork\n"; $test++;} |
2c8ac474 |
245 | } |
246 | else { |
247 | print "# \$!='$!'\nnot " unless open(local $f, '|-', <<'EOC'); |
248 | ./perl -pe "s/^not //" |
249 | EOC |
250 | ok; |
251 | @rows = <$f>; |
252 | print $f "not ok $test\n"; $test++; |
253 | print $f "not ok $test\n"; $test++; |
254 | print "#\nnot " unless close($f); |
255 | sleep 1; |
256 | ok; |
257 | } |
258 | |
259 | # 63..64 |
260 | eval <<'EOE' and print "not "; |
261 | open local $f, '<&', 'afile'; |
262 | 1; |
263 | EOE |
264 | ok; |
4fbc943a |
265 | $@ =~ /Bad filehandle:\s+afile/ or print "not "; |
2c8ac474 |
266 | ok; |
faecd977 |
267 | |
268 | # 65..66 |
269 | { |
270 | local *F; |
ed2efe3e |
271 | for (1..2) { |
a6c71b5b |
272 | if ($Is_Dos) { |
05af4e39 |
273 | open(F, "echo \\#foo|") or print "not "; |
a6c71b5b |
274 | } else { |
275 | open(F, "echo #foo|") or print "not "; |
276 | } |
ed2efe3e |
277 | print <F>; |
278 | close F; |
279 | } |
280 | ok; |
281 | for (1..2) { |
a6c71b5b |
282 | if ($Is_Dos) { |
05af4e39 |
283 | open(F, "-|", "echo \\#foo") or print "not "; |
a6c71b5b |
284 | } else { |
285 | open(F, "-|", "echo #foo") or print "not "; |
286 | } |
ed2efe3e |
287 | print <F>; |
288 | close F; |
289 | } |
faecd977 |
290 | ok; |
291 | } |
f6c77cf1 |
292 | |
293 | # 67..70 - magic temporary file via 3 arg open with undef |
294 | { |
295 | open(my $x,"+<",undef) or print "not "; |
296 | ok; |
297 | print "not " unless defined(fileno($x)); |
298 | ok; |
299 | select $x; |
300 | ok; # goes to $x |
301 | select STDOUT; |
302 | seek($x,0,0); |
303 | print <$x>; |
304 | print "not " unless tell($x) > 3; |
305 | ok; |
306 | } |