ext/PerlIO/t/via.t

   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     }
  10     require Config;
  11     if (($Config::Config{'extensions'} !~ m!\bPerlIO/via\b!) ){
  12         print "1..0 # Skip -- Perl configured without PerlIO::via module\n";
  13         exit 0;
  14     }
  15 }
  16
  17 use strict;
  18 use warnings;
  19
  20 my $tmp = "via$$";
  21
  22 use Test::More tests => 18;
  23
  24 my $fh;
  25 my $a = join("", map { chr } 0..255) x 10;
  26 my $b;
  27
  28 BEGIN { use_ok('PerlIO::via::QuotedPrint'); }
  29
  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');
  32 ok( (print $fh $a), "print to output file");
  33 ok( close($fh), 'close output file');
  34
  35 ok( open($fh,"<via(PerlIO::via::QuotedPrint)", $tmp), 'open QuotedPrint for input');
  36 { local $/; $b = <$fh> }
  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';
  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
  53     ok( ! open($fh,">via(Unknown::Module)", $tmp), 'open via Unknown::Module will fail');
  54     like( $warnings, qr/^Cannot find package 'Unknown::Module'/,  'warn about unknown package' );
  55
  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
  66 {
  67 package Incomplete::Module;
  68 }
  69
  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" );
  74
  75     $warnings = '';
  76     no warnings 'layer';
  77     ok( ! open($fh,">via(Unknown::Module)", $tmp), 'open via Unknown::Module will fail');
  78     is( $warnings, "",  "don't warn about unknown package" );
  79 }
  80
  81 my $obj = '';
  82 sub Foo::PUSHED                 { $obj = shift; -1; }
  83 sub PerlIO::via::Bar::PUSHED    { $obj = shift; -1; }
  84 open $fh, '<:via(Foo)', "foo";
  85 is( $obj, 'Foo', 'search for package Foo' );
  86 open $fh, '<:via(Bar)', "bar";
  87 is( $obj, 'PerlIO::via::Bar', 'search for package PerlIO::via::Bar' );
  88
  89 END {
  90     1 while unlink $tmp;
  91 }
  92