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