Fix fd leak on Via(bogus).
[p5sagit/p5-mst-13.2.git] / ext / PerlIO / t / via.t
1 #!./perl
2
3 use strict;
4 use warnings;
5
6 BEGIN {
7     chdir 't' if -d 't';
8     @INC = '../lib';
9     unless (find PerlIO::Layer 'perlio') {
10         print "1..0 # Skip: not perlio\n";
11         exit 0;
12     }
13 }
14
15 my $tmp = "via$$";
16
17 use Test::More tests => 13;
18
19 my $fh;
20 my $a = join("", map { chr } 0..255) x 10;
21 my $b;
22
23 BEGIN { use_ok('MIME::QuotedPrint'); }
24
25 ok( open($fh,">Via(MIME::QuotedPrint)", $tmp), 'open QuotedPrint for output');
26 ok( (print $fh $a), "print to output file");
27 ok( close($fh), 'close output file');
28
29 ok( open($fh,"<Via(MIME::QuotedPrint)", $tmp), 'open QuotedPrint for input');
30 { local $/; $b = <$fh> }
31 ok( close($fh), "close input file");
32
33 is($a, $b, 'compare original data with filtered version');
34
35
36 {
37     my $warnings = '';
38     local $SIG{__WARN__} = sub { $warnings = join '', @_ };
39
40     use warnings 'layer';
41
42     # Find fd number we should be using
43     my $fd = open($fh,">$tmp") && fileno($fh);
44     print $fh "Hello\n";
45     close($fh);
46
47     ok( ! open($fh,">Via(Unknown::Module)", $tmp), 'open Via Unknown::Module will fail');
48     like( $warnings, qr/^Cannot find package 'Unknown::Module'/,  'warn about unknown package' );
49
50     # Now open normally again to see if we get right fileno
51     my $fd2 = open($fh,"<$tmp") && fileno($fh);
52     is($fd2,$fd,"Wrong fd number after failed open");
53
54     my $data = <$fh>;
55
56     is($data,"Hello\n","File clobbered by failed open");
57
58     close($fh);
59
60
61
62     $warnings = '';
63     no warnings 'layer';
64     ok( ! open($fh,">Via(Unknown::Module)", $tmp), 'open Via Unknown::Module will fail');
65     is( $warnings, "",  "don't warn about unknown package" );
66 }
67
68 END {
69     1 while unlink $tmp;
70 }