xref: /openbsd/gnu/usr.bin/perl/t/io/perlio_fail.t (revision 771fbea0)
1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    require "../t/test.pl";
6    set_up_inc('../lib');
7    skip_all_without_perlio();
8}
9
10plan (15);
11
12use warnings 'layer';
13my $warn;
14my $file = "fail$$";
15$SIG{__WARN__} = sub { $warn = shift };
16
17END { 1 while unlink($file) }
18
19ok(open(FH,">",$file),"Create works");
20close(FH);
21ok(open(FH,"<",$file),"Normal open works");
22
23$warn = ''; $! = 0;
24ok(!binmode(FH,":-)"),"All punctuation fails binmode");
25print "# $!\n";
26isnt($!,0,"Got errno");
27like($warn,qr/in PerlIO layer/,"Got warning");
28
29$warn = ''; $! = 0;
30ok(!binmode(FH,":nonesuch"),"Bad package fails binmode");
31print "# $!\n";
32isnt($!,0,"Got errno");
33like($warn,qr/nonesuch/,"Got warning");
34close(FH);
35
36$warn = ''; $! = 0;
37ok(!open(FH,"<:-)",$file),"All punctuation fails open");
38print "# $!\n";
39isnt($!,"","Got errno");
40like($warn,qr/in PerlIO layer/,"Got warning");
41
42$warn = ''; $! = 0;
43ok(!open(FH,"<:nonesuch",$file),"Bad package fails open");
44print "# $!\n";
45isnt($!,0,"Got errno");
46like($warn,qr/nonesuch/,"Got warning");
47
48ok(open(FH,"<",$file),"Normal open (still) works");
49close(FH);
50