Add missing files from the Encode CPAN distribution
[perl.git] / ext / Encode / t / piconv.t
1 #
2 # $Id: piconv.t,v 0.2 2009/07/13 00:50:52 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 my $WIN = $^O eq 'MSWin32';
20
21 if ($WIN) {
22     eval { require IPC::Run; IPC::Run->VERSION(0.83); 1; } or 
23         plan skip_all => 'Win32 environments require IPC::Run 0.83 to complete this test';
24 }
25
26 sub run_cmd (;$$);
27
28 my $blib =
29   File::Spec->rel2abs(
30     File::Spec->catdir( $FindBin::RealBin, File::Spec->updir, 'blib' ) );
31 my $script = File::Spec->catdir($blib, 'script', 'piconv');
32 my @base_cmd = ( $^X, "-Mblib=$blib", $script );
33
34 plan tests => 5;
35
36 {
37     my ( $st, $out, $err ) = run_cmd;
38     is( $st, 0, 'status for usage call' );
39     is( $out, $WIN ? undef : '' );
40     like( $err, qr{^piconv}, 'usage' );
41 }
42
43 {
44     my($st, $out, $err) = run_cmd [qw(-S foobar -f utf-8 -t ascii), $script];
45     like($err, qr{unknown scheme.*fallback}i, 'warning for unknown scheme');
46 }
47
48 {
49     my ( $st, $out, $err ) = run_cmd [qw(-f utf-8 -t ascii ./non-existing/file)];
50     like( $err, qr{can't open}i );
51 }
52
53 sub run_cmd (;$$) {
54     my ( $args, $in ) = @_;
55     
56     my $out = "x" x 10_000;
57     $out = "";
58     my $err = "x" x 10_000;
59     $err = "";
60         
61     if ($WIN) {
62                 IPC::Run->import(qw(run timeout));
63                 my @cmd;
64                 if (defined $args) {
65                         @cmd = (@base_cmd, @$args);
66                 } else {
67                         @cmd = @base_cmd;
68                 }
69         run(\@cmd, \$in, \$out, \$err, timeout(10));
70         my $st = $?;
71                 $out = undef if ($out eq '');
72         ( $st, $out, $err );
73     } else {
74                 $in ||= '';
75         my ( $in_fh, $out_fh, $err_fh );
76         use Symbol 'gensym';
77         $err_fh =
78           gensym;    # sigh... otherwise stderr gets just to $out_fh, not to $err_fh
79         my $pid = open3( $in_fh, $out_fh, $err_fh, @base_cmd, @$args )
80           or die "Can't run @base_cmd @$args: $!";
81         print $in_fh $in;
82         my $sel = IO::Select->new( $out_fh, $err_fh );
83
84         while ( my @ready = $sel->can_read ) {
85             for my $fh (@ready) {
86                 if ( eof($fh) ) {
87                     $sel->remove($fh);
88                     last if !$sel->handles;
89                 }
90                 elsif ( $out_fh == $fh ) {
91                     my $line = <$fh>;
92                     $out .= $line;
93                 }
94                 elsif ( $err_fh == $fh ) {
95                     my $line = <$fh>;
96                     $err .= $line;
97                 }
98             }
99         }
100         my $st = $?;
101         ( $st, $out, $err );
102     }
103 }