Commit | Line | Data |
3eb568f1 |
1 | #!./perl |
2 | |
9f1b1f2d |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
20822f61 |
5 | @INC = '../lib'; |
ad20d923 |
6 | require './test.pl'; |
e620cd72 |
7 | } |
9f1b1f2d |
8 | |
853846ea |
9 | $| = 1; |
9f1b1f2d |
10 | use warnings; |
35066d42 |
11 | use Config; |
dc459aad |
12 | $Is_MacOS = $^O eq 'MacOS'; |
3eb568f1 |
13 | |
ac53db4c |
14 | plan tests => 108; |
2c8ac474 |
15 | |
b5fe401b |
16 | my $Perl = which_perl(); |
17 | |
6170680b |
18 | { |
e620cd72 |
19 | unlink("afile") if -f "afile"; |
ad20d923 |
20 | |
21 | $! = 0; # the -f above will set $! if 'afile' doesn't exist. |
22 | ok( open(my $f,"+>afile"), 'open(my $f, "+>...")' ); |
23 | |
2c8ac474 |
24 | binmode $f; |
ad20d923 |
25 | ok( -f "afile", ' its a file'); |
26 | ok( (print $f "SomeData\n"), ' we can print to it'); |
27 | is( tell($f), 9, ' tell()' ); |
28 | ok( seek($f,0,0), ' seek set' ); |
29 | |
2c8ac474 |
30 | $b = <$f>; |
ad20d923 |
31 | is( $b, "SomeData\n", ' readline' ); |
32 | ok( -f $f, ' still a file' ); |
33 | |
e620cd72 |
34 | eval { die "Message" }; |
ad20d923 |
35 | like( $@, qr/<\$f> line 1/, ' die message correct' ); |
36 | |
37 | ok( close($f), ' close()' ); |
38 | ok( unlink("afile"), ' unlink()' ); |
6170680b |
39 | } |
2c8ac474 |
40 | |
6170680b |
41 | { |
ad20d923 |
42 | ok( open(my $f,'>', 'afile'), "open(my \$f, '>', 'afile')" ); |
43 | ok( (print $f "a row\n"), ' print'); |
44 | ok( close($f), ' close' ); |
45 | ok( -s 'afile' < 10, ' -s' ); |
6170680b |
46 | } |
2c8ac474 |
47 | |
6170680b |
48 | { |
ad20d923 |
49 | ok( open(my $f,'>>', 'afile'), "open(my \$f, '>>', 'afile')" ); |
50 | ok( (print $f "a row\n"), ' print' ); |
51 | ok( close($f), ' close' ); |
52 | ok( -s 'afile' > 10, ' -s' ); |
6170680b |
53 | } |
2c8ac474 |
54 | |
6170680b |
55 | { |
ad20d923 |
56 | ok( open(my $f, '<', 'afile'), "open(my \$f, '<', 'afile')" ); |
57 | my @rows = <$f>; |
58 | is( scalar @rows, 2, ' readline, list context' ); |
59 | is( $rows[0], "a row\n", ' first line read' ); |
60 | is( $rows[1], "a row\n", ' second line' ); |
61 | ok( close($f), ' close' ); |
6170680b |
62 | } |
2c8ac474 |
63 | |
6170680b |
64 | { |
ad20d923 |
65 | ok( -s 'afile' < 20, '-s' ); |
66 | |
67 | ok( open(my $f, '+<', 'afile'), 'open +<' ); |
68 | my @rows = <$f>; |
69 | is( scalar @rows, 2, ' readline, list context' ); |
70 | ok( seek($f, 0, 1), ' seek cur' ); |
71 | ok( (print $f "yet another row\n"), ' print' ); |
72 | ok( close($f), ' close' ); |
73 | ok( -s 'afile' > 20, ' -s' ); |
2c8ac474 |
74 | |
e620cd72 |
75 | unlink("afile"); |
2c8ac474 |
76 | } |
c0ed5c75 |
77 | { |
ad20d923 |
78 | ok( open(my $f, '-|', <<EOC), 'open -|' ); |
dc459aad |
79 | $Perl -e "print qq(a row\\n); print qq(another row\\n)" |
6170680b |
80 | EOC |
2c8ac474 |
81 | |
ad20d923 |
82 | my @rows = <$f>; |
83 | is( scalar @rows, 2, ' readline, list context' ); |
84 | ok( close($f), ' close' ); |
2c8ac474 |
85 | } |
dc459aad |
86 | SKIP: { |
87 | skip "Output for |- doesn't go to shell on MacOS", 5 if $Is_MacOS; |
88 | |
ad20d923 |
89 | ok( open(my $f, '|-', <<EOC), 'open |-' ); |
b5fe401b |
90 | $Perl -pe "s/^not //" |
6170680b |
91 | EOC |
ad20d923 |
92 | |
93 | my @rows = <$f>; |
94 | my $test = curr_test; |
95 | print $f "not ok $test - piped in\n"; |
96 | next_test; |
97 | |
98 | $test = curr_test; |
99 | print $f "not ok $test - piped in\n"; |
100 | next_test; |
101 | ok( close($f), ' close' ); |
2c8ac474 |
102 | sleep 1; |
ad20d923 |
103 | pass('flushing'); |
6170680b |
104 | } |
3eb568f1 |
105 | |
2c8ac474 |
106 | |
ad20d923 |
107 | ok( !eval { open my $f, '<&', 'afile'; 1; }, '<& on a non-filehandle' ); |
108 | like( $@, qr/Bad filehandle:\s+afile/, ' right error' ); |
2c8ac474 |
109 | |
ad20d923 |
110 | |
111 | # local $file tests |
2c8ac474 |
112 | { |
e620cd72 |
113 | unlink("afile") if -f "afile"; |
ad20d923 |
114 | |
115 | ok( open(local $f,"+>afile"), 'open local $f, "+>", ...' ); |
2c8ac474 |
116 | binmode $f; |
ad20d923 |
117 | |
118 | ok( -f "afile", ' -f' ); |
119 | ok( (print $f "SomeData\n"), ' print' ); |
120 | is( tell($f), 9, ' tell' ); |
121 | ok( seek($f,0,0), ' seek set' ); |
122 | |
2c8ac474 |
123 | $b = <$f>; |
ad20d923 |
124 | is( $b, "SomeData\n", ' readline' ); |
125 | ok( -f $f, ' still a file' ); |
126 | |
e620cd72 |
127 | eval { die "Message" }; |
ad20d923 |
128 | like( $@, qr/<\$f> line 1/, ' proper die message' ); |
129 | ok( close($f), ' close' ); |
130 | |
e620cd72 |
131 | unlink("afile"); |
2c8ac474 |
132 | } |
133 | |
2c8ac474 |
134 | { |
ad20d923 |
135 | ok( open(local $f,'>', 'afile'), 'open local $f, ">", ...' ); |
136 | ok( (print $f "a row\n"), ' print'); |
137 | ok( close($f), ' close'); |
138 | ok( -s 'afile' < 10, ' -s' ); |
2c8ac474 |
139 | } |
140 | |
2c8ac474 |
141 | { |
ad20d923 |
142 | ok( open(local $f,'>>', 'afile'), 'open local $f, ">>", ...' ); |
143 | ok( (print $f "a row\n"), ' print'); |
144 | ok( close($f), ' close'); |
145 | ok( -s 'afile' > 10, ' -s' ); |
2c8ac474 |
146 | } |
147 | |
2c8ac474 |
148 | { |
ad20d923 |
149 | ok( open(local $f, '<', 'afile'), 'open local $f, "<", ...' ); |
150 | my @rows = <$f>; |
151 | is( scalar @rows, 2, ' readline list context' ); |
152 | ok( close($f), ' close' ); |
2c8ac474 |
153 | } |
154 | |
ad20d923 |
155 | ok( -s 'afile' < 20, ' -s' ); |
156 | |
2c8ac474 |
157 | { |
ad20d923 |
158 | ok( open(local $f, '+<', 'afile'), 'open local $f, "+<", ...' ); |
159 | my @rows = <$f>; |
160 | is( scalar @rows, 2, ' readline list context' ); |
161 | ok( seek($f, 0, 1), ' seek cur' ); |
162 | ok( (print $f "yet another row\n"), ' print' ); |
163 | ok( close($f), ' close' ); |
164 | ok( -s 'afile' > 20, ' -s' ); |
2c8ac474 |
165 | |
e620cd72 |
166 | unlink("afile"); |
2c8ac474 |
167 | } |
168 | |
c0ed5c75 |
169 | { |
ad20d923 |
170 | ok( open(local $f, '-|', <<EOC), 'open local $f, "-|", ...' ); |
dc459aad |
171 | $Perl -e "print qq(a row\\n); print qq(another row\\n)" |
2c8ac474 |
172 | EOC |
ad20d923 |
173 | my @rows = <$f>; |
2c8ac474 |
174 | |
ad20d923 |
175 | is( scalar @rows, 2, ' readline list context' ); |
176 | ok( close($f), ' close' ); |
2c8ac474 |
177 | } |
ad20d923 |
178 | |
dc459aad |
179 | SKIP: { |
180 | skip "Output for |- doesn't go to shell on MacOS", 5 if $Is_MacOS; |
181 | |
ad20d923 |
182 | ok( open(local $f, '|-', <<EOC), 'open local $f, "|-", ...' ); |
b5fe401b |
183 | $Perl -pe "s/^not //" |
2c8ac474 |
184 | EOC |
ad20d923 |
185 | |
186 | my @rows = <$f>; |
187 | my $test = curr_test; |
188 | print $f "not ok $test - piping\n"; |
189 | next_test; |
190 | |
191 | $test = curr_test; |
192 | print $f "not ok $test - piping\n"; |
193 | next_test; |
194 | ok( close($f), ' close' ); |
2c8ac474 |
195 | sleep 1; |
ad20d923 |
196 | pass("Flush"); |
2c8ac474 |
197 | } |
198 | |
faecd977 |
199 | |
ad20d923 |
200 | ok( !eval { open local $f, '<&', 'afile'; 1 }, 'local <& on non-filehandle'); |
201 | like( $@, qr/Bad filehandle:\s+afile/, ' right error' ); |
202 | |
faecd977 |
203 | { |
204 | local *F; |
ed2efe3e |
205 | for (1..2) { |
24a7a40d |
206 | ok( open(F, qq{$Perl -le "print 'ok'"|}), 'open to pipe' ); |
ad20d923 |
207 | is(scalar <F>, "ok\n", ' readline'); |
24a7a40d |
208 | ok( close F, ' close' ); |
ed2efe3e |
209 | } |
ad20d923 |
210 | |
ed2efe3e |
211 | for (1..2) { |
24a7a40d |
212 | ok( open(F, "-|", qq{$Perl -le "print 'ok'"}), 'open -|'); |
213 | is( scalar <F>, "ok\n", ' readline'); |
ad20d923 |
214 | ok( close F, ' close' ); |
ed2efe3e |
215 | } |
faecd977 |
216 | } |
f6c77cf1 |
217 | |
04dd828a |
218 | |
219 | # other dupping techniques |
220 | { |
24a7a40d |
221 | ok( open(my $stdout, ">&", \*STDOUT), 'dup \*STDOUT into lexical fh'); |
222 | ok( open(STDOUT, ">&", $stdout), 'restore dupped STDOUT from lexical fh'); |
223 | |
3b82e551 |
224 | { |
225 | use strict; # the below should not warn |
226 | ok( open(my $stdout, ">&", STDOUT), 'dup STDOUT into lexical fh'); |
227 | } |
228 | |
24a7a40d |
229 | # used to try to open a file [perl #17830] |
0685228b |
230 | ok( open(my $stdin, "<&", fileno STDIN), 'dup fileno(STDIN) into lexical fh') or _diag $!; |
04dd828a |
231 | } |
232 | |
35066d42 |
233 | SKIP: { |
234 | skip "This perl uses perlio", 1 if $Config{useperlio}; |
43651d81 |
235 | skip "miniperl cannot be relied on to load %Errno" |
236 | if $ENV{PERL_CORE_MINITEST}; |
237 | # Force the reference to %! to be run time by writing ! as {"!"} |
238 | skip "This system doesn't understand EINVAL", 1 |
239 | unless exists ${"!"}{EINVAL}; |
35066d42 |
240 | |
aaac28e4 |
241 | no warnings 'io'; |
43651d81 |
242 | ok(!open(F,'>',\my $s) && ${"!"}{EINVAL}, 'open(reference) raises EINVAL'); |
35066d42 |
243 | } |
244 | |
245 | { |
246 | ok( !eval { open F, "BAR", "QUUX" }, 'Unknown open() mode' ); |
247 | like( $@, qr/\QUnknown open() mode 'BAR'/, ' right error' ); |
248 | } |
0c4b0a3f |
249 | |
250 | { |
251 | local $SIG{__WARN__} = sub { $@ = shift }; |
252 | |
253 | sub gimme { |
254 | my $tmphandle = shift; |
255 | my $line = scalar <$tmphandle>; |
256 | warn "gimme"; |
257 | return $line; |
258 | } |
259 | |
260 | open($fh0[0], "TEST"); |
261 | gimme($fh0[0]); |
262 | like($@, qr/<\$fh0\[...\]> line 1\./, "autoviv fh package aelem"); |
263 | |
264 | open($fh1{k}, "TEST"); |
265 | gimme($fh1{k}); |
266 | like($@, qr/<\$fh1{...}> line 1\./, "autoviv fh package helem"); |
267 | |
268 | my @fh2; |
269 | open($fh2[0], "TEST"); |
270 | gimme($fh2[0]); |
271 | like($@, qr/<\$fh2\[...\]> line 1\./, "autoviv fh lexical aelem"); |
272 | |
273 | my %fh3; |
274 | open($fh3{k}, "TEST"); |
275 | gimme($fh3{k}); |
276 | like($@, qr/<\$fh3{...}> line 1\./, "autoviv fh lexical helem"); |
0c4b0a3f |
277 | } |
278 | |
7e72d509 |
279 | SKIP: { |
a9f76400 |
280 | skip("These tests use perlio", 5) unless $Config{useperlio}; |
7e72d509 |
281 | my $w; |
282 | use warnings 'layer'; |
283 | local $SIG{__WARN__} = sub { $w = shift }; |
284 | |
285 | eval { open(F, ">>>", "afile") }; |
b4581f09 |
286 | like($w, qr/Invalid separator character '>' in PerlIO layer spec/, |
a9f76400 |
287 | "bad open (>>>) warning"); |
7e72d509 |
288 | like($@, qr/Unknown open\(\) mode '>>>'/, |
a9f76400 |
289 | "bad open (>>>) failure"); |
290 | |
291 | eval { open(F, ">:u", "afile" ) }; |
b4581f09 |
292 | like($w, qr/Unknown PerlIO layer "u"/, |
a9f76400 |
293 | 'bad layer ">:u" warning'); |
294 | eval { open(F, "<:u", "afile" ) }; |
b4581f09 |
295 | like($w, qr/Unknown PerlIO layer "u"/, |
a9f76400 |
296 | 'bad layer "<:u" warning'); |
b4581f09 |
297 | eval { open(F, ":c", "afile" ) }; |
298 | like($@, qr/Unknown open\(\) mode ':c'/, |
299 | 'bad layer ":c" failure'); |
7e72d509 |
300 | } |
301 | |
15332aa2 |
302 | # [perl #28986] "open m" crashes Perl |
303 | |
304 | fresh_perl_like('open m', qr/^Search pattern not terminated at/, |
305 | { stderr => 1 }, 'open m test'); |
306 | |
ba2ce822 |
307 | fresh_perl_is( |
308 | 'sub f { open(my $fh, "xxx"); $fh = "f"; } f; f;print "ok"', |
309 | 'ok', { stderr => 1 }, |
310 | '#29102: Crash on assignment to lexical filehandle'); |
ac53db4c |
311 | |
312 | # [perl #31767] Using $1 as a filehandle via open $1, "file" doesn't raise |
313 | # an exception |
314 | |
315 | eval { open $99, "foo" }; |
316 | like($@, qr/Modification of a read-only value attempted/, "readonly fh"); |