ext/Encode/t/piconv.t

   1 #
   2 # $Id: piconv.t,v 0.1 2009/07/08 12:34:21 dankogai Exp $
   3 #
   4
   5 BEGIN {
   6     if ( $ENV{'PERL_CORE'} ) {
   7         print "1..0 # Skip: Don't know how to test this within perl's core\n";
   8         exit 0;
   9     }
  10 }
  11
  12 use strict;
  13 use FindBin;
  14 use File::Spec;
  15 use IPC::Open3 qw(open3);
  16 use IO::Select;
  17 use Test::More;
  18
  19 sub run_cmd (;$$);
  20
  21 my $blib =
  22   File::Spec->rel2abs(
  23     File::Spec->catfile( $FindBin::RealBin, File::Spec->updir, 'blib' ) );
  24 my $script = "$blib/script/piconv";
  25 my @base_cmd = ( $^X, "-Mblib=$blib", $script );
  26
  27 plan tests => 5;
  28
  29 {
  30     my ( $st, $out, $err ) = run_cmd;
  31     is( $st, 0, 'status for usage call' );
  32     is( $out, undef );
  33     like( $err, qr{^piconv}, 'usage' );
  34 }
  35
  36 {
  37     my($st, $out, $err) = run_cmd [qw(-S foobar -f utf-8 -t ascii), $script];
  38     like($err, qr{unknown scheme.*fallback}i, 'warning for unknown scheme');
  39 }
  40
  41 {
  42     my ( $st, $out, $err ) = run_cmd [qw(-f utf-8 -t ascii ./non-existing/file)];
  43     like( $err, qr{can't open}i );
  44 }
  45
  46 sub run_cmd (;$$) {
  47     my ( $args, $in ) = @_;
  48     $in ||= '';
  49     my ( $out, $err );
  50     my ( $in_fh, $out_fh, $err_fh );
  51     use Symbol 'gensym';
  52     $err_fh =
  53       gensym;    # sigh... otherwise stderr gets just to $out_fh, not to $err_fh
  54     my $pid = open3( $in_fh, $out_fh, $err_fh, @base_cmd, @$args )
  55       or die "Can't run @base_cmd @$args: $!";
  56     print $in_fh $in;
  57     my $sel = IO::Select->new( $out_fh, $err_fh );
  58
  59     while ( my @ready = $sel->can_read ) {
  60         for my $fh (@ready) {
  61             if ( eof($fh) ) {
  62                 $sel->remove($fh);
  63                 last if !$sel->handles;
  64             }
  65             elsif ( $out_fh == $fh ) {
  66                 my $line = <$fh>;
  67                 $out .= $line;
  68             }
  69             elsif ( $err_fh == $fh ) {
  70                 my $line = <$fh>;
  71                 $err .= $line;
  72             }
  73         }
  74     }
  75     my $st = $?;
  76     ( $st, $out, $err );
  77 }