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