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; |
3eb568f1 | 12 | |
788436d2 | 13 | plan tests => 153; |
2c8ac474 | 14 | |
b5fe401b MS |
15 | my $Perl = which_perl(); |
16 | ||
62a28c97 | 17 | my $afile = tempfile(); |
6170680b | 18 | { |
62a28c97 | 19 | unlink($afile) if -f $afile; |
ad20d923 | 20 | |
62a28c97 NC |
21 | $! = 0; # the -f above will set $! if $afile doesn't exist. |
22 | ok( open(my $f,"+>$afile"), 'open(my $f, "+>...")' ); | |
ad20d923 | 23 | |
2c8ac474 | 24 | binmode $f; |
62a28c97 | 25 | ok( -f $afile, ' its a file'); |
ad20d923 MS |
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 MS |
31 | is( $b, "SomeData\n", ' readline' ); |
32 | ok( -f $f, ' still a file' ); | |
33 | ||
e620cd72 | 34 | eval { die "Message" }; |
ad20d923 MS |
35 | like( $@, qr/<\$f> line 1/, ' die message correct' ); |
36 | ||
37 | ok( close($f), ' close()' ); | |
62a28c97 | 38 | ok( unlink($afile), ' unlink()' ); |
6170680b | 39 | } |
2c8ac474 | 40 | |
6170680b | 41 | { |
62a28c97 | 42 | ok( open(my $f,'>', $afile), "open(my \$f, '>', $afile)" ); |
ad20d923 MS |
43 | ok( (print $f "a row\n"), ' print'); |
44 | ok( close($f), ' close' ); | |
62a28c97 | 45 | ok( -s $afile < 10, ' -s' ); |
6170680b | 46 | } |
2c8ac474 | 47 | |
6170680b | 48 | { |
62a28c97 | 49 | ok( open(my $f,'>>', $afile), "open(my \$f, '>>', $afile)" ); |
ad20d923 MS |
50 | ok( (print $f "a row\n"), ' print' ); |
51 | ok( close($f), ' close' ); | |
62a28c97 | 52 | ok( -s $afile > 10, ' -s' ); |
6170680b | 53 | } |
2c8ac474 | 54 | |
6170680b | 55 | { |
62a28c97 | 56 | ok( open(my $f, '<', $afile), "open(my \$f, '<', $afile)" ); |
ad20d923 MS |
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 | { |
62a28c97 | 65 | ok( -s $afile < 20, '-s' ); |
ad20d923 | 66 | |
62a28c97 | 67 | ok( open(my $f, '+<', $afile), 'open +<' ); |
ad20d923 MS |
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' ); | |
62a28c97 | 73 | ok( -s $afile > 20, ' -s' ); |
2c8ac474 | 74 | |
62a28c97 | 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 MS |
82 | my @rows = <$f>; |
83 | is( scalar @rows, 2, ' readline, list context' ); | |
84 | ok( close($f), ' close' ); | |
2c8ac474 | 85 | } |
7b903762 | 86 | { |
ad20d923 | 87 | ok( open(my $f, '|-', <<EOC), 'open |-' ); |
b5fe401b | 88 | $Perl -pe "s/^not //" |
6170680b | 89 | EOC |
ad20d923 MS |
90 | |
91 | my @rows = <$f>; | |
92 | my $test = curr_test; | |
93 | print $f "not ok $test - piped in\n"; | |
94 | next_test; | |
95 | ||
96 | $test = curr_test; | |
97 | print $f "not ok $test - piped in\n"; | |
98 | next_test; | |
99 | ok( close($f), ' close' ); | |
2c8ac474 | 100 | sleep 1; |
ad20d923 | 101 | pass('flushing'); |
6170680b | 102 | } |
3eb568f1 | 103 | |
2c8ac474 | 104 | |
62a28c97 NC |
105 | ok( !eval { open my $f, '<&', $afile; 1; }, '<& on a non-filehandle' ); |
106 | like( $@, qr/Bad filehandle:\s+$afile/, ' right error' ); | |
2c8ac474 | 107 | |
2a0f5ef0 BF |
108 | ok( !eval { *some_glob = 1; open my $f, '<&', *some_glob; 1; }, '<& on a non-filehandle glob' ); |
109 | like( $@, qr/Bad filehandle:\s+some_glob/, ' right error' ); | |
110 | ||
111 | { | |
112 | use utf8; | |
113 | use open qw( :utf8 :std ); | |
114 | ok( !eval { use utf8; *ǡfilḛ = 1; open my $f, '<&', *ǡfilḛ; 1; }, '<& on a non-filehandle glob' ); | |
115 | like( $@, qr/Bad filehandle:\s+ǡfilḛ/u, ' right error' ); | |
116 | } | |
ad20d923 MS |
117 | |
118 | # local $file tests | |
2c8ac474 | 119 | { |
62a28c97 | 120 | unlink($afile) if -f $afile; |
ad20d923 | 121 | |
62a28c97 | 122 | ok( open(local $f,"+>$afile"), 'open local $f, "+>", ...' ); |
2c8ac474 | 123 | binmode $f; |
ad20d923 | 124 | |
62a28c97 | 125 | ok( -f $afile, ' -f' ); |
ad20d923 MS |
126 | ok( (print $f "SomeData\n"), ' print' ); |
127 | is( tell($f), 9, ' tell' ); | |
128 | ok( seek($f,0,0), ' seek set' ); | |
129 | ||
2c8ac474 | 130 | $b = <$f>; |
ad20d923 MS |
131 | is( $b, "SomeData\n", ' readline' ); |
132 | ok( -f $f, ' still a file' ); | |
133 | ||
e620cd72 | 134 | eval { die "Message" }; |
ad20d923 MS |
135 | like( $@, qr/<\$f> line 1/, ' proper die message' ); |
136 | ok( close($f), ' close' ); | |
137 | ||
62a28c97 | 138 | unlink($afile); |
2c8ac474 GS |
139 | } |
140 | ||
2c8ac474 | 141 | { |
62a28c97 | 142 | ok( open(local $f,'>', $afile), 'open local $f, ">", ...' ); |
ad20d923 MS |
143 | ok( (print $f "a row\n"), ' print'); |
144 | ok( close($f), ' close'); | |
62a28c97 | 145 | ok( -s $afile < 10, ' -s' ); |
2c8ac474 GS |
146 | } |
147 | ||
2c8ac474 | 148 | { |
62a28c97 | 149 | ok( open(local $f,'>>', $afile), 'open local $f, ">>", ...' ); |
ad20d923 MS |
150 | ok( (print $f "a row\n"), ' print'); |
151 | ok( close($f), ' close'); | |
62a28c97 | 152 | ok( -s $afile > 10, ' -s' ); |
2c8ac474 GS |
153 | } |
154 | ||
2c8ac474 | 155 | { |
62a28c97 | 156 | ok( open(local $f, '<', $afile), 'open local $f, "<", ...' ); |
ad20d923 MS |
157 | my @rows = <$f>; |
158 | is( scalar @rows, 2, ' readline list context' ); | |
159 | ok( close($f), ' close' ); | |
2c8ac474 GS |
160 | } |
161 | ||
62a28c97 | 162 | ok( -s $afile < 20, ' -s' ); |
ad20d923 | 163 | |
2c8ac474 | 164 | { |
62a28c97 | 165 | ok( open(local $f, '+<', $afile), 'open local $f, "+<", ...' ); |
ad20d923 MS |
166 | my @rows = <$f>; |
167 | is( scalar @rows, 2, ' readline list context' ); | |
168 | ok( seek($f, 0, 1), ' seek cur' ); | |
169 | ok( (print $f "yet another row\n"), ' print' ); | |
170 | ok( close($f), ' close' ); | |
62a28c97 | 171 | ok( -s $afile > 20, ' -s' ); |
2c8ac474 | 172 | |
62a28c97 | 173 | unlink($afile); |
2c8ac474 GS |
174 | } |
175 | ||
c0ed5c75 | 176 | { |
ad20d923 | 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 | |
7b903762 | 186 | { |
ad20d923 | 187 | ok( open(local $f, '|-', <<EOC), 'open local $f, "|-", ...' ); |
b5fe401b | 188 | $Perl -pe "s/^not //" |
2c8ac474 | 189 | EOC |
ad20d923 MS |
190 | |
191 | my @rows = <$f>; | |
192 | my $test = curr_test; | |
193 | print $f "not ok $test - piping\n"; | |
194 | next_test; | |
195 | ||
196 | $test = curr_test; | |
197 | print $f "not ok $test - piping\n"; | |
198 | next_test; | |
199 | ok( close($f), ' close' ); | |
2c8ac474 | 200 | sleep 1; |
ad20d923 | 201 | pass("Flush"); |
2c8ac474 GS |
202 | } |
203 | ||
faecd977 | 204 | |
62a28c97 NC |
205 | ok( !eval { open local $f, '<&', $afile; 1 }, 'local <& on non-filehandle'); |
206 | like( $@, qr/Bad filehandle:\s+$afile/, ' right error' ); | |
ad20d923 | 207 | |
faecd977 GS |
208 | { |
209 | local *F; | |
ed2efe3e | 210 | for (1..2) { |
24a7a40d | 211 | ok( open(F, qq{$Perl -le "print 'ok'"|}), 'open to pipe' ); |
ad20d923 | 212 | is(scalar <F>, "ok\n", ' readline'); |
24a7a40d | 213 | ok( close F, ' close' ); |
ed2efe3e | 214 | } |
ad20d923 | 215 | |
ed2efe3e | 216 | for (1..2) { |
24a7a40d SG |
217 | ok( open(F, "-|", qq{$Perl -le "print 'ok'"}), 'open -|'); |
218 | is( scalar <F>, "ok\n", ' readline'); | |
ad20d923 | 219 | ok( close F, ' close' ); |
ed2efe3e | 220 | } |
faecd977 | 221 | } |
f6c77cf1 | 222 | |
04dd828a JH |
223 | |
224 | # other dupping techniques | |
225 | { | |
24a7a40d SG |
226 | ok( open(my $stdout, ">&", \*STDOUT), 'dup \*STDOUT into lexical fh'); |
227 | ok( open(STDOUT, ">&", $stdout), 'restore dupped STDOUT from lexical fh'); | |
228 | ||
3b82e551 JH |
229 | { |
230 | use strict; # the below should not warn | |
231 | ok( open(my $stdout, ">&", STDOUT), 'dup STDOUT into lexical fh'); | |
232 | } | |
233 | ||
24a7a40d | 234 | # used to try to open a file [perl #17830] |
0685228b | 235 | ok( open(my $stdin, "<&", fileno STDIN), 'dup fileno(STDIN) into lexical fh') or _diag $!; |
f90b7232 FC |
236 | |
237 | fileno(STDIN) =~ /(.)/; | |
238 | ok open($stdin, "<&", $1), 'open ... "<&", $magical_fileno', | |
239 | || _diag $!; | |
04dd828a JH |
240 | } |
241 | ||
35066d42 RGS |
242 | SKIP: { |
243 | skip "This perl uses perlio", 1 if $Config{useperlio}; | |
d3d1232e | 244 | skip_if_miniperl("miniperl can't rely on loading %Errno", 1); |
43651d81 NC |
245 | # Force the reference to %! to be run time by writing ! as {"!"} |
246 | skip "This system doesn't understand EINVAL", 1 | |
247 | unless exists ${"!"}{EINVAL}; | |
35066d42 | 248 | |
aaac28e4 | 249 | no warnings 'io'; |
43651d81 | 250 | ok(!open(F,'>',\my $s) && ${"!"}{EINVAL}, 'open(reference) raises EINVAL'); |
35066d42 RGS |
251 | } |
252 | ||
253 | { | |
254 | ok( !eval { open F, "BAR", "QUUX" }, 'Unknown open() mode' ); | |
255 | like( $@, qr/\QUnknown open() mode 'BAR'/, ' right error' ); | |
256 | } | |
0c4b0a3f JH |
257 | |
258 | { | |
259 | local $SIG{__WARN__} = sub { $@ = shift }; | |
260 | ||
261 | sub gimme { | |
262 | my $tmphandle = shift; | |
263 | my $line = scalar <$tmphandle>; | |
264 | warn "gimme"; | |
265 | return $line; | |
266 | } | |
267 | ||
268 | open($fh0[0], "TEST"); | |
269 | gimme($fh0[0]); | |
270 | like($@, qr/<\$fh0\[...\]> line 1\./, "autoviv fh package aelem"); | |
271 | ||
272 | open($fh1{k}, "TEST"); | |
273 | gimme($fh1{k}); | |
2a53d331 | 274 | like($@, qr/<\$fh1\{...}> line 1\./, "autoviv fh package helem"); |
0c4b0a3f JH |
275 | |
276 | my @fh2; | |
277 | open($fh2[0], "TEST"); | |
278 | gimme($fh2[0]); | |
279 | like($@, qr/<\$fh2\[...\]> line 1\./, "autoviv fh lexical aelem"); | |
280 | ||
281 | my %fh3; | |
282 | open($fh3{k}, "TEST"); | |
283 | gimme($fh3{k}); | |
2a53d331 | 284 | like($@, qr/<\$fh3\{...}> line 1\./, "autoviv fh lexical helem"); |
2748e602 FC |
285 | |
286 | local $/ = *F; # used to cause an assertion failure | |
287 | gimme($fh3{k}); | |
288 | like($@, qr/<\$fh3\{...}> chunk 2\./, | |
289 | '<...> line 1 when $/ is set to a glob'); | |
0c4b0a3f JH |
290 | } |
291 | ||
7e72d509 | 292 | SKIP: { |
a9f76400 | 293 | skip("These tests use perlio", 5) unless $Config{useperlio}; |
7e72d509 JH |
294 | my $w; |
295 | use warnings 'layer'; | |
296 | local $SIG{__WARN__} = sub { $w = shift }; | |
297 | ||
62a28c97 | 298 | eval { open(F, ">>>", $afile) }; |
b4581f09 | 299 | like($w, qr/Invalid separator character '>' in PerlIO layer spec/, |
a9f76400 | 300 | "bad open (>>>) warning"); |
7e72d509 | 301 | like($@, qr/Unknown open\(\) mode '>>>'/, |
a9f76400 JH |
302 | "bad open (>>>) failure"); |
303 | ||
62a28c97 | 304 | eval { open(F, ">:u", $afile ) }; |
b4581f09 | 305 | like($w, qr/Unknown PerlIO layer "u"/, |
a9f76400 | 306 | 'bad layer ">:u" warning'); |
62a28c97 | 307 | eval { open(F, "<:u", $afile ) }; |
b4581f09 | 308 | like($w, qr/Unknown PerlIO layer "u"/, |
a9f76400 | 309 | 'bad layer "<:u" warning'); |
62a28c97 | 310 | eval { open(F, ":c", $afile ) }; |
b4581f09 JH |
311 | like($@, qr/Unknown open\(\) mode ':c'/, |
312 | 'bad layer ":c" failure'); | |
7e72d509 JH |
313 | } |
314 | ||
15332aa2 DM |
315 | # [perl #28986] "open m" crashes Perl |
316 | ||
317 | fresh_perl_like('open m', qr/^Search pattern not terminated at/, | |
318 | { stderr => 1 }, 'open m test'); | |
319 | ||
ba2ce822 DM |
320 | fresh_perl_is( |
321 | 'sub f { open(my $fh, "xxx"); $fh = "f"; } f; f;print "ok"', | |
322 | 'ok', { stderr => 1 }, | |
323 | '#29102: Crash on assignment to lexical filehandle'); | |
ac53db4c DM |
324 | |
325 | # [perl #31767] Using $1 as a filehandle via open $1, "file" doesn't raise | |
326 | # an exception | |
327 | ||
328 | eval { open $99, "foo" }; | |
329 | like($@, qr/Modification of a read-only value attempted/, "readonly fh"); | |
ce74145d FC |
330 | # But we do not want that exception applying to close(), since it does not |
331 | # modify the fh. | |
332 | eval { | |
333 | no warnings "uninitialized"; | |
334 | # make sure $+ is undefined | |
335 | "a" =~ /(b)?/; | |
336 | close $+ | |
337 | }; | |
338 | is($@, '', 'no "Modification of a read-only value" when closing'); | |
d71e3dc3 DM |
339 | |
340 | # [perl#73626] mg_get wasn't run on the pipe arg | |
341 | ||
342 | { | |
343 | package p73626; | |
344 | sub TIESCALAR { bless {} } | |
345 | sub FETCH { "$Perl -e 1"} | |
346 | ||
347 | tie my $p, 'p73626'; | |
348 | ||
349 | package main; | |
350 | ||
351 | ok( open(my $f, '-|', $p), 'open -| magic'); | |
352 | } | |
10cea945 FC |
353 | |
354 | # [perl #77492] Crash when stringifying a glob, a reference to which has | |
355 | # been opened and written to. | |
356 | fresh_perl_is( | |
357 | ' | |
358 | open my $fh, ">", \*STDOUT; | |
359 | print $fh "hello"; | |
360 | "".*STDOUT; | |
361 | print "ok"; | |
3208277d | 362 | close $fh; |
10cea945 FC |
363 | unlink \*STDOUT; |
364 | ', | |
365 | 'ok', { stderr => 1 }, | |
366 | '[perl #77492]: open $fh, ">", \*glob causes SEGV'); | |
526fd1b4 FC |
367 | |
368 | # [perl #77684] Opening a reference to a glob copy. | |
eed19f4a NC |
369 | SKIP: { |
370 | skip_if_miniperl("no dynamic loading on miniperl, so can't load PerlIO::scalar", 1); | |
526fd1b4 FC |
371 | my $var = *STDOUT; |
372 | open my $fh, ">", \$var; | |
373 | print $fh "hello"; | |
374 | is $var, "hello", '[perl #77684]: open $fh, ">", \$glob_copy' | |
375 | # when this fails, it leaves an extra file: | |
376 | or unlink \*STDOUT; | |
377 | } | |
15e6cdd9 DG |
378 | |
379 | # check that we can call methods on filehandles auto-magically | |
380 | # and have IO::File loaded for us | |
19d240ff NC |
381 | SKIP: { |
382 | skip_if_miniperl("no dynamic loading on miniperl, so can't load IO::File", 3); | |
15e6cdd9 DG |
383 | is( $INC{'IO/File.pm'}, undef, "IO::File not loaded" ); |
384 | my $var = ""; | |
385 | open my $fh, ">", \$var; | |
386 | ok( eval { $fh->autoflush(1); 1 }, '$fh->autoflush(1) lives' ); | |
387 | ok( $INC{'IO/File.pm'}, "IO::File now loaded" ); | |
388 | } | |
94e7eb6f FC |
389 | |
390 | sub _117941 { package _117941; open my $a, "TEST" } | |
391 | delete $::{"_117941::"}; | |
392 | _117941(); | |
393 | pass("no crash when open autovivifies glob in freed package"); | |
c8028aa6 TC |
394 | |
395 | # [perl #117265] check for embedded nul in pathnames, allow ending \0 though | |
396 | { | |
397 | my $WARN; | |
398 | local $SIG{__WARN__} = sub { $WARN = shift }; | |
399 | my $temp = tempfile(); | |
400 | my $temp_match = quotemeta $temp; | |
401 | ||
402 | # create the file, so we can check nothing actually touched it | |
403 | open my $temp_fh, ">", $temp; | |
404 | close $temp_fh; | |
405 | ok(utime(time()-10, time(), $temp), "set mtime to a known value"); | |
406 | ok(chmod(0666, $temp), "set mode to a known value"); | |
407 | my ($final_mode, $final_mtime) = (stat $temp)[2, 9]; | |
408 | ||
409 | my $fn = "$temp\0.invalid"; | |
788436d2 | 410 | my $fno = bless \(my $fn2 = "$temp\0.overload"), "OverloadTest"; |
c8028aa6 TC |
411 | is(open(I, $fn), undef, "open with nul in pathnames since 5.18 [perl #117265]"); |
412 | like($WARN, qr/^Invalid \\0 character in pathname for open: $temp_match\\0\.invalid/, | |
413 | "warn on embedded nul"); $WARN = ''; | |
788436d2 TC |
414 | is(open(I, $fno), undef, "open with nul in pathnames since 5.18 [perl #117265] (overload)"); |
415 | like($WARN, qr/^Invalid \\0 character in pathname for open: $temp_match\\0\.overload/, | |
416 | "warn on embedded nul"); $WARN = ''; | |
417 | ||
418 | is(chmod(0444, $fn), 0, "chmod fails with \\0 in name"); | |
c8028aa6 TC |
419 | like($WARN, qr/^Invalid \\0 character in pathname for chmod: $temp_match\\0\.invalid/, |
420 | "also on chmod"); $WARN = ''; | |
788436d2 | 421 | |
788436d2 TC |
422 | is(chmod(0444, $fno), 0, "chmod fails with \\0 in name (overload)"); |
423 | like($WARN, qr/^Invalid \\0 character in pathname for chmod: $temp_match\\0\.overload/, | |
424 | "also on chmod"); $WARN = ''; | |
788436d2 TC |
425 | |
426 | is (glob($fn), undef, "glob fails with \\0 in name"); | |
c8028aa6 TC |
427 | like($WARN, qr/^Invalid \\0 character in pattern for glob: $temp_match\\0\.invalid/, |
428 | "also on glob"); $WARN = ''; | |
429 | ||
788436d2 TC |
430 | is (glob($fno), undef, "glob fails with \\0 in name (overload)"); |
431 | like($WARN, qr/^Invalid \\0 character in pattern for glob: $temp_match\\0\.overload/, | |
432 | "also on glob"); $WARN = ''; | |
788436d2 | 433 | |
c8028aa6 TC |
434 | { |
435 | no warnings 'syscalls'; | |
436 | $WARN = ''; | |
437 | is(open(I, $fn), undef, "open with nul with no warnings syscalls"); | |
438 | is($WARN, '', "ignore warning on embedded nul with no warnings syscalls"); | |
439 | } | |
440 | ||
441 | use Errno 'ENOENT'; | |
442 | # check handling of multiple arguments, which the original patch | |
443 | # mis-handled | |
444 | $! = 0; | |
445 | is (unlink($fn, $fn), 0, "check multiple arguments to unlink"); | |
446 | is($!+0, ENOENT, "check errno"); | |
447 | $! = 0; | |
448 | is (chmod(0644, $fn, $fn), 0, "check multiple arguments to chmod"); | |
449 | is($!+0, ENOENT, "check errno"); | |
450 | $! = 0; | |
451 | is (utime(time, time, $fn, $fn), 0, "check multiple arguments to utime"); | |
452 | is($!+0, ENOENT, "check errno"); | |
453 | SKIP: { | |
454 | skip "no chown", 2 unless $Config{d_chown}; | |
455 | $! = 0; | |
456 | is(chown(-1, -1, $fn, $fn), 0, "check multiple arguments to chown"); | |
457 | is($!+0, ENOENT, "check errno"); | |
458 | } | |
459 | ||
788436d2 TC |
460 | is (unlink($fn), 0, "unlink fails with \\0 in name"); |
461 | like($WARN, qr/^Invalid \\0 character in pathname for unlink: $temp_match\\0\.invalid/, | |
462 | "also on unlink"); $WARN = ''; | |
463 | ||
788436d2 TC |
464 | is (unlink($fno), 0, "unlink fails with \\0 in name (overload)"); |
465 | like($WARN, qr/^Invalid \\0 character in pathname for unlink: $temp_match\\0\.overload/, | |
466 | "also on unlink"); $WARN = ''; | |
467 | ||
c8028aa6 TC |
468 | ok(-f $temp, "nothing removed the temp file"); |
469 | is((stat $temp)[2], $final_mode, "nothing changed its mode"); | |
470 | is((stat $temp)[9], $final_mtime, "nothing changes its mtime"); | |
471 | } | |
788436d2 TC |
472 | |
473 | ||
474 | package OverloadTest; | |
475 | use overload '""' => sub { ${$_[0]} }; |