This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make open fail when layer string does not parse.
[perl5.git] / ext / PerlIO / t / fail.t
CommitLineData
0cff2cf3
NIS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6 require "../t/test.pl";
7 skip_all("No perlio") unless (find PerlIO::Layer 'perlio');
8 plan (16);
9}
10
11use warnings 'layer';
12my $warn;
13my $file = "fail$$";
14$SIG{__WARN__} = sub { $warn = shift };
15
16END { 1 while unlink($file) }
17
18ok(open(FH,">",$file),"Create works");
19close(FH);
20ok(open(FH,"<",$file),"Normal open works");
21
22$warn = ''; $! = 0;
23ok(!binmode(FH,":-)"),"All punctuation fails binmode");
24like($!,'Invalid',"Got errno");
25like($warn,qr/in layer/,"Got warning");
26
27$warn = ''; $! = 0;
28ok(!binmode(FH,":nonesuch"),"Bad package fails binmode");
29like($!,'No such',"Got errno");
30like($warn,qr/nonesuch/,"Got warning");
31close(FH);
32
33$warn = ''; $! = 0;
34ok(!open(FH,"<:-)",$file),"All punctuation fails open");
35like($!,"Invalid","Got errno");
36like($warn,qr/in layer/,"Got warning");
37isnt($!,"","Got errno");
38
39$warn = ''; $! = 0;
40ok(!open(FH,"<:nonesuch",$file),"Bad package fails open");
41like($!,"No such","Got errno");
42like($warn,qr/nonesuch/,"Got warning");
43
44ok(open(FH,"<",$file),"Normal open (still) works");
45close(FH);