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