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 (15);
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");
24print "# $!\n";
25isnt($!,0,"Got errno");
26like($warn,qr/in PerlIO layer/,"Got warning");
27
28$warn = ''; $! = 0;
29ok(!binmode(FH,":nonesuch"),"Bad package fails binmode");
30print "# $!\n";
31isnt($!,0,"Got errno");
32like($warn,qr/nonesuch/,"Got warning");
33close(FH);
34
35$warn = ''; $! = 0;
36ok(!open(FH,"<:-)",$file),"All punctuation fails open");
37print "# $!\n";
38isnt($!,"","Got errno");
39like($warn,qr/in PerlIO layer/,"Got warning");
40
41$warn = ''; $! = 0;
42ok(!open(FH,"<:nonesuch",$file),"Bad package fails open");
43print "# $!\n";
44isnt($!,0,"Got errno");
45like($warn,qr/nonesuch/,"Got warning");
46
47ok(open(FH,"<",$file),"Normal open (still) works");
48close(FH);
49