Move Encode from ext/ to cpan/
[perl.git] / cpan / Encode / t / piconv.t
1 #
2 # $Id: piconv.t,v 0.2 2009/07/13 00:50:52 dankogai Exp $
3 #
4
5 use strict;
6 use FindBin;
7 use File::Spec;
8 use IPC::Open3 qw(open3);
9 use IO::Select;
10 use Test::More;
11
12 my $WIN = $^O eq 'MSWin32';
13
14 if ($WIN) {
15     eval { require IPC::Run; IPC::Run->VERSION(0.83); 1; } or 
16         plan skip_all => 'Win32 environments require IPC::Run 0.83 to complete this test';
17 }
18
19 sub run_cmd (;$$);
20
21 my $blib =
22   File::Spec->rel2abs(
23     File::Spec->catdir( $FindBin::RealBin, File::Spec->updir, 'blib' ) );
24 my $script = File::Spec->catdir($blib, 'script', 'piconv');
25 my @base_cmd = ( $^X, ($ENV{PERL_CORE} ? () : "-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, $WIN ? 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     
49     my $out = "x" x 10_000;
50     $out = "";
51     my $err = "x" x 10_000;
52     $err = "";
53         
54     if ($WIN) {
55                 IPC::Run->import(qw(run timeout));
56                 my @cmd;
57                 if (defined $args) {
58                         @cmd = (@base_cmd, @$args);
59                 } else {
60                         @cmd = @base_cmd;
61                 }
62         run(\@cmd, \$in, \$out, \$err, timeout(10));
63         my $st = $?;
64                 $out = undef if ($out eq '');
65         ( $st, $out, $err );
66     } else {
67                 $in ||= '';
68         my ( $in_fh, $out_fh, $err_fh );
69         use Symbol 'gensym';
70         $err_fh =
71           gensym;    # sigh... otherwise stderr gets just to $out_fh, not to $err_fh
72         my $pid = open3( $in_fh, $out_fh, $err_fh, @base_cmd, @$args )
73           or die "Can't run @base_cmd @$args: $!";
74         print $in_fh $in;
75         my $sel = IO::Select->new( $out_fh, $err_fh );
76
77         while ( my @ready = $sel->can_read ) {
78             for my $fh (@ready) {
79                 if ( eof($fh) ) {
80                     $sel->remove($fh);
81                     last if !$sel->handles;
82                 }
83                 elsif ( $out_fh == $fh ) {
84                     my $line = <$fh>;
85                     $out .= $line;
86                 }
87                 elsif ( $err_fh == $fh ) {
88                     my $line = <$fh>;
89                     $err .= $line;
90                 }
91             }
92         }
93         my $st = $?;
94         ( $st, $out, $err );
95     }
96 }