Commit | Line | Data |
2b8740d8 |
1 | #!./perl |
2 | |
99ef548b |
3 | use strict; |
4 | use warnings; |
5 | |
2b8740d8 |
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 | |
d9dac8cd |
17 | use Test::More tests => 13; |
99ef548b |
18 | |
19 | my $fh; |
20 | my $a = join("", map { chr } 0..255) x 10; |
21 | my $b; |
2b8740d8 |
22 | |
99ef548b |
23 | BEGIN { use_ok('MIME::QuotedPrint'); } |
2b8740d8 |
24 | |
99ef548b |
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'); |
2b8740d8 |
28 | |
99ef548b |
29 | ok( open($fh,"<Via(MIME::QuotedPrint)", $tmp), 'open QuotedPrint for input'); |
2b8740d8 |
30 | { local $/; $b = <$fh> } |
99ef548b |
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'; |
d9dac8cd |
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 | |
99ef548b |
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' ); |
2b8740d8 |
49 | |
d9dac8cd |
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 | |
99ef548b |
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" ); |
d9dac8cd |
66 | } |
2b8740d8 |
67 | |
68 | END { |
69 | 1 while unlink $tmp; |
70 | } |