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