Commit | Line | Data |
2b8740d8 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
6 | unless (find PerlIO::Layer 'perlio') { |
7 | print "1..0 # Skip: not perlio\n"; |
8 | exit 0; |
9 | } |
740dabb8 |
10 | require Config; |
98641f60 |
11 | if (($Config::Config{'extensions'} !~ m!\bPerlIO/via\b!) ){ |
740dabb8 |
12 | print "1..0 # Skip -- Perl configured without PerlIO::via module\n"; |
13 | exit 0; |
14 | } |
2b8740d8 |
15 | } |
16 | |
740dabb8 |
17 | use strict; |
18 | use warnings; |
19 | |
2b8740d8 |
20 | my $tmp = "via$$"; |
21 | |
4f776d34 |
22 | use Test::More tests => 18; |
99ef548b |
23 | |
24 | my $fh; |
25 | my $a = join("", map { chr } 0..255) x 10; |
26 | my $b; |
2b8740d8 |
27 | |
e934609f |
28 | BEGIN { use_ok('PerlIO::via::QuotedPrint'); } |
2b8740d8 |
29 | |
e934609f |
30 | ok( !open($fh,"<via(PerlIO::via::QuotedPrint)", $tmp), 'open QuotedPrint for input fails'); |
31 | ok( open($fh,">via(PerlIO::via::QuotedPrint)", $tmp), 'open QuotedPrint for output'); |
99ef548b |
32 | ok( (print $fh $a), "print to output file"); |
33 | ok( close($fh), 'close output file'); |
2b8740d8 |
34 | |
e934609f |
35 | ok( open($fh,"<via(PerlIO::via::QuotedPrint)", $tmp), 'open QuotedPrint for input'); |
2b8740d8 |
36 | { local $/; $b = <$fh> } |
99ef548b |
37 | ok( close($fh), "close input file"); |
38 | |
39 | is($a, $b, 'compare original data with filtered version'); |
40 | |
41 | |
42 | { |
43 | my $warnings = ''; |
44 | local $SIG{__WARN__} = sub { $warnings = join '', @_ }; |
45 | |
46 | use warnings 'layer'; |
d9dac8cd |
47 | |
48 | # Find fd number we should be using |
49 | my $fd = open($fh,">$tmp") && fileno($fh); |
50 | print $fh "Hello\n"; |
51 | close($fh); |
52 | |
e934609f |
53 | ok( ! open($fh,">via(Unknown::Module)", $tmp), 'open via Unknown::Module will fail'); |
99ef548b |
54 | like( $warnings, qr/^Cannot find package 'Unknown::Module'/, 'warn about unknown package' ); |
2b8740d8 |
55 | |
d9dac8cd |
56 | # Now open normally again to see if we get right fileno |
57 | my $fd2 = open($fh,"<$tmp") && fileno($fh); |
58 | is($fd2,$fd,"Wrong fd number after failed open"); |
59 | |
60 | my $data = <$fh>; |
61 | |
62 | is($data,"Hello\n","File clobbered by failed open"); |
63 | |
64 | close($fh); |
65 | |
4f776d34 |
66 | { |
67 | package Incomplete::Module; |
68 | } |
d9dac8cd |
69 | |
4f776d34 |
70 | $warnings = ''; |
71 | no warnings 'layer'; |
72 | ok( ! open($fh,">via(Incomplete::Module)", $tmp), 'open via Incomplete::Module will fail'); |
73 | is( $warnings, "", "don't warn about unknown package" ); |
d9dac8cd |
74 | |
99ef548b |
75 | $warnings = ''; |
76 | no warnings 'layer'; |
e934609f |
77 | ok( ! open($fh,">via(Unknown::Module)", $tmp), 'open via Unknown::Module will fail'); |
99ef548b |
78 | is( $warnings, "", "don't warn about unknown package" ); |
d9dac8cd |
79 | } |
2b8740d8 |
80 | |
52f3c1af |
81 | my $obj = ''; |
82 | sub Foo::PUSHED { $obj = shift; -1; } |
e934609f |
83 | sub PerlIO::via::Bar::PUSHED { $obj = shift; -1; } |
84 | open $fh, '<:via(Foo)', "foo"; |
52f3c1af |
85 | is( $obj, 'Foo', 'search for package Foo' ); |
e934609f |
86 | open $fh, '<:via(Bar)', "bar"; |
87 | is( $obj, 'PerlIO::via::Bar', 'search for package PerlIO::via::Bar' ); |
52f3c1af |
88 | |
2b8740d8 |
89 | END { |
90 | 1 while unlink $tmp; |
91 | } |
30ef3321 |
92 | |