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