#!./perl
+use strict;
+use warnings;
+
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
my $tmp = "via$$";
-print "1..3\n";
+use Test::More tests => 18;
+
+my $fh;
+my $a = join("", map { chr } 0..255) x 10;
+my $b;
-$a = join("", map { chr } 0..255) x 10;
+BEGIN { use_ok('PerlIO::via::QuotedPrint'); }
-use MIME::QuotedPrint;
-open(my $fh,">Via(MIME::QuotedPrint)", $tmp);
-print $fh $a;
-close($fh);
-print "ok 1\n";
+ok( !open($fh,"<via(PerlIO::via::QuotedPrint)", $tmp), 'open QuotedPrint for input fails');
+ok( open($fh,">via(PerlIO::via::QuotedPrint)", $tmp), 'open QuotedPrint for output');
+ok( (print $fh $a), "print to output file");
+ok( close($fh), 'close output file');
-open(my $fh,"<Via(MIME::QuotedPrint)", $tmp);
+ok( open($fh,"<via(PerlIO::via::QuotedPrint)", $tmp), 'open QuotedPrint for input');
{ local $/; $b = <$fh> }
-close($fh);
-print "ok 2\n";
+ok( close($fh), "close input file");
+
+is($a, $b, 'compare original data with filtered version');
+
+
+{
+ my $warnings = '';
+ local $SIG{__WARN__} = sub { $warnings = join '', @_ };
+
+ use warnings 'layer';
+
+ # Find fd number we should be using
+ my $fd = open($fh,">$tmp") && fileno($fh);
+ print $fh "Hello\n";
+ close($fh);
+
+ ok( ! open($fh,">via(Unknown::Module)", $tmp), 'open via Unknown::Module will fail');
+ like( $warnings, qr/^Cannot find package 'Unknown::Module'/, 'warn about unknown package' );
+
+ # Now open normally again to see if we get right fileno
+ my $fd2 = open($fh,"<$tmp") && fileno($fh);
+ is($fd2,$fd,"Wrong fd number after failed open");
-print "ok 3\n" if $a eq $b;
+ my $data = <$fh>;
+
+ is($data,"Hello\n","File clobbered by failed open");
+
+ close($fh);
+
+{
+package Incomplete::Module;
+}
+
+ $warnings = '';
+ no warnings 'layer';
+ ok( ! open($fh,">via(Incomplete::Module)", $tmp), 'open via Incomplete::Module will fail');
+ is( $warnings, "", "don't warn about unknown package" );
+
+ $warnings = '';
+ no warnings 'layer';
+ ok( ! open($fh,">via(Unknown::Module)", $tmp), 'open via Unknown::Module will fail');
+ is( $warnings, "", "don't warn about unknown package" );
+}
+
+my $obj = '';
+sub Foo::PUSHED { $obj = shift; -1; }
+sub PerlIO::via::Bar::PUSHED { $obj = shift; -1; }
+open $fh, '<:via(Foo)', "foo";
+is( $obj, 'Foo', 'search for package Foo' );
+open $fh, '<:via(Bar)', "bar";
+is( $obj, 'PerlIO::via::Bar', 'search for package PerlIO::via::Bar' );
END {
1 while unlink $tmp;
}
+