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 | |
30ef3321 |
17 | use Test::More tests => 16; |
99ef548b |
18 | |
19 | my $fh; |
20 | my $a = join("", map { chr } 0..255) x 10; |
21 | my $b; |
2b8740d8 |
22 | |
b31b80f9 |
23 | BEGIN { use_ok('PerlIO::Via::QuotedPrint'); } |
2b8740d8 |
24 | |
b31b80f9 |
25 | ok( !open($fh,"<Via(PerlIO::Via::QuotedPrint)", $tmp), 'open QuotedPrint for input fails'); |
26 | ok( open($fh,">Via(PerlIO::Via::QuotedPrint)", $tmp), 'open QuotedPrint for output'); |
99ef548b |
27 | ok( (print $fh $a), "print to output file"); |
28 | ok( close($fh), 'close output file'); |
2b8740d8 |
29 | |
b31b80f9 |
30 | ok( open($fh,"<Via(PerlIO::Via::QuotedPrint)", $tmp), 'open QuotedPrint for input'); |
2b8740d8 |
31 | { local $/; $b = <$fh> } |
99ef548b |
32 | ok( close($fh), "close input file"); |
33 | |
34 | is($a, $b, 'compare original data with filtered version'); |
35 | |
36 | |
37 | { |
38 | my $warnings = ''; |
39 | local $SIG{__WARN__} = sub { $warnings = join '', @_ }; |
40 | |
41 | use warnings 'layer'; |
d9dac8cd |
42 | |
43 | # Find fd number we should be using |
44 | my $fd = open($fh,">$tmp") && fileno($fh); |
45 | print $fh "Hello\n"; |
46 | close($fh); |
47 | |
99ef548b |
48 | ok( ! open($fh,">Via(Unknown::Module)", $tmp), 'open Via Unknown::Module will fail'); |
49 | like( $warnings, qr/^Cannot find package 'Unknown::Module'/, 'warn about unknown package' ); |
2b8740d8 |
50 | |
d9dac8cd |
51 | # Now open normally again to see if we get right fileno |
52 | my $fd2 = open($fh,"<$tmp") && fileno($fh); |
53 | is($fd2,$fd,"Wrong fd number after failed open"); |
54 | |
55 | my $data = <$fh>; |
56 | |
57 | is($data,"Hello\n","File clobbered by failed open"); |
58 | |
59 | close($fh); |
60 | |
61 | |
62 | |
99ef548b |
63 | $warnings = ''; |
64 | no warnings 'layer'; |
65 | ok( ! open($fh,">Via(Unknown::Module)", $tmp), 'open Via Unknown::Module will fail'); |
66 | is( $warnings, "", "don't warn about unknown package" ); |
d9dac8cd |
67 | } |
2b8740d8 |
68 | |
52f3c1af |
69 | my $obj = ''; |
70 | sub Foo::PUSHED { $obj = shift; -1; } |
71 | sub PerlIO::Via::Bar::PUSHED { $obj = shift; -1; } |
72 | open $fh, '<:Via(Foo)', "foo"; |
73 | is( $obj, 'Foo', 'search for package Foo' ); |
74 | open $fh, '<:Via(Bar)', "bar"; |
75 | is( $obj, 'PerlIO::Via::Bar', 'search for package PerlIO::Via::Bar' ); |
76 | |
2b8740d8 |
77 | END { |
78 | 1 while unlink $tmp; |
79 | } |
30ef3321 |
80 | |