This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
USE_ITHREADS tweak (reused pad values could be SvREADONLY if
[perl5.git] / t / io / open.t
CommitLineData
3eb568f1
NIS
1#!./perl
2
3# $RCSfile$
853846ea
NIS
4$| = 1;
5$^W = 1;
821b8a23 6$Is_VMS = $^O eq 'VMS';
3eb568f1 7
faecd977 8print "1..66\n";
2c8ac474
GS
9
10my $test = 1;
11
12sub ok { print "ok $test\n"; $test++ }
3eb568f1 13
853846ea
NIS
14# my $file tests
15
2c8ac474 16# 1..9
6170680b 17{
2c8ac474
GS
18 unlink("afile") if -f "afile";
19 print "$!\nnot " unless open(my $f,"+>afile");
20 ok;
21 binmode $f;
22 print "not " unless -f "afile";
23 ok;
24 print "not " unless print $f "SomeData\n";
25 ok;
26 print "not " unless tell($f) == 9;
27 ok;
28 print "not " unless seek($f,0,0);
29 ok;
30 $b = <$f>;
31 print "not " unless $b eq "SomeData\n";
32 ok;
33 print "not " unless -f $f;
34 ok;
35 eval { die "Message" };
36 # warn $@;
37 print "not " unless $@ =~ /<\$f> line 1/;
38 ok;
39 print "not " unless close($f);
40 ok;
41 unlink("afile");
6170680b 42}
2c8ac474
GS
43
44# 10..12
6170680b 45{
2c8ac474
GS
46 print "# \$!='$!'\nnot " unless open(my $f,'>', 'afile');
47 ok;
48 print $f "a row\n";
49 print "not " unless close($f);
50 ok;
51 print "not " unless -s 'afile' < 10;
52 ok;
6170680b 53}
2c8ac474
GS
54
55# 13..15
6170680b 56{
2c8ac474
GS
57 print "# \$!='$!'\nnot " unless open(my $f,'>>', 'afile');
58 ok;
59 print $f "a row\n";
60 print "not " unless close($f);
61 ok;
62 print "not " unless -s 'afile' > 10;
63 ok;
6170680b 64}
2c8ac474
GS
65
66# 16..18
6170680b 67{
2c8ac474
GS
68 print "# \$!='$!'\nnot " unless open(my $f, '<', 'afile');
69 ok;
70 @rows = <$f>;
71 print "not " unless @rows == 2;
72 ok;
73 print "not " unless close($f);
74 ok;
6170680b 75}
2c8ac474
GS
76
77# 19..23
6170680b 78{
2c8ac474
GS
79 print "not " unless -s 'afile' < 20;
80 ok;
81 print "# \$!='$!'\nnot " unless open(my $f, '+<', 'afile');
82 ok;
83 @rows = <$f>;
84 print "not " unless @rows == 2;
85 ok;
86 seek $f, 0, 1;
87 print $f "yet another row\n";
88 print "not " unless close($f);
89 ok;
90 print "not " unless -s 'afile' > 20;
91 ok;
92
93 unlink("afile");
94}
95
96# 24..26
97if ($Is_VMS) {
98 for (24..26) { print "ok $_ # skipped: not Unix fork\n"; }
99}
821b8a23 100else {
2c8ac474
GS
101 print "# \$!='$!'\nnot " unless open(my $f, '-|', <<'EOC');
102 ./perl -e "print qq(a row\n); print qq(another row\n)"
6170680b 103EOC
2c8ac474
GS
104 ok;
105 @rows = <$f>;
106 print "not " unless @rows == 2;
107 ok;
108 print "not " unless close($f);
109 ok;
110}
111
112# 27..30
113if ($Is_VMS) {
114 for (27..30) { print "ok $_ # skipped: not Unix fork\n"; }
115}
821b8a23 116else {
2c8ac474
GS
117 print "# \$!='$!'\nnot " unless open(my $f, '|-', <<'EOC');
118 ./perl -pe "s/^not //"
6170680b 119EOC
2c8ac474
GS
120 ok;
121 @rows = <$f>;
122 print $f "not ok $test\n"; $test++;
123 print $f "not ok $test\n"; $test++;
124 print "#\nnot " unless close($f);
125 sleep 1;
126 ok;
6170680b 127}
3eb568f1 128
2c8ac474 129# 31..32
6170680b
IZ
130eval <<'EOE' and print "not ";
131open my $f, '<&', 'afile';
1321;
133EOE
2c8ac474
GS
134ok;
135$@ =~ /Unknown open\(\) mode \'<&\'/ or print "not ";
136ok;
137
138# local $file tests
139
140# 33..41
141{
142 unlink("afile") if -f "afile";
143 print "$!\nnot " unless open(local $f,"+>afile");
144 ok;
145 binmode $f;
146 print "not " unless -f "afile";
147 ok;
148 print "not " unless print $f "SomeData\n";
149 ok;
150 print "not " unless tell($f) == 9;
151 ok;
152 print "not " unless seek($f,0,0);
153 ok;
154 $b = <$f>;
155 print "not " unless $b eq "SomeData\n";
156 ok;
157 print "not " unless -f $f;
158 ok;
159 eval { die "Message" };
160 # warn $@;
161 print "not " unless $@ =~ /<\$f> line 1/;
162 ok;
163 print "not " unless close($f);
164 ok;
165 unlink("afile");
166}
167
168# 42..44
169{
170 print "# \$!='$!'\nnot " unless open(local $f,'>', 'afile');
171 ok;
172 print $f "a row\n";
173 print "not " unless close($f);
174 ok;
175 print "not " unless -s 'afile' < 10;
176 ok;
177}
178
179# 45..47
180{
181 print "# \$!='$!'\nnot " unless open(local $f,'>>', 'afile');
182 ok;
183 print $f "a row\n";
184 print "not " unless close($f);
185 ok;
186 print "not " unless -s 'afile' > 10;
187 ok;
188}
189
190# 48..50
191{
192 print "# \$!='$!'\nnot " unless open(local $f, '<', 'afile');
193 ok;
194 @rows = <$f>;
195 print "not " unless @rows == 2;
196 ok;
197 print "not " unless close($f);
198 ok;
199}
200
201# 51..55
202{
203 print "not " unless -s 'afile' < 20;
204 ok;
205 print "# \$!='$!'\nnot " unless open(local $f, '+<', 'afile');
206 ok;
207 @rows = <$f>;
208 print "not " unless @rows == 2;
209 ok;
210 seek $f, 0, 1;
211 print $f "yet another row\n";
212 print "not " unless close($f);
213 ok;
214 print "not " unless -s 'afile' > 20;
215 ok;
216
217 unlink("afile");
218}
219
220# 56..58
221if ($Is_VMS) {
222 for (56..58) { print "ok $_ # skipped: not Unix fork\n"; }
223}
224else {
225 print "# \$!='$!'\nnot " unless open(local $f, '-|', <<'EOC');
226 ./perl -e "print qq(a row\n); print qq(another row\n)"
227EOC
228 ok;
229 @rows = <$f>;
230 print "not " unless @rows == 2;
231 ok;
232 print "not " unless close($f);
233 ok;
234}
235
236# 59..62
237if ($Is_VMS) {
238 for (59..62) { print "ok $_ # skipped: not Unix fork\n"; }
239}
240else {
241 print "# \$!='$!'\nnot " unless open(local $f, '|-', <<'EOC');
242 ./perl -pe "s/^not //"
243EOC
244 ok;
245 @rows = <$f>;
246 print $f "not ok $test\n"; $test++;
247 print $f "not ok $test\n"; $test++;
248 print "#\nnot " unless close($f);
249 sleep 1;
250 ok;
251}
252
253# 63..64
254eval <<'EOE' and print "not ";
255open local $f, '<&', 'afile';
2561;
257EOE
258ok;
6170680b 259$@ =~ /Unknown open\(\) mode \'<&\'/ or print "not ";
2c8ac474 260ok;
faecd977
GS
261
262# 65..66
263{
264 local *F;
265 for (1..2) { open(F, "echo #foo|") or print "not "; }
266 ok;
267 for (1..2) { open(F, "-|", "echo #foo") or print "not "; }
268 ok;
269}