Commit | Line | Data |
b3f8c6ea |
1 | # |
b2deda17 |
2 | # $Id: piconv.t,v 0.3 2009/11/16 14:08:13 dankogai Exp dankogai $ |
b3f8c6ea |
3 | # |
4 | |
b2deda17 |
5 | BEGIN { |
6 | if ( $ENV{'PERL_CORE'} && $] >= 5.011) { |
7 | print "1..0 # Skip: Don't know how to test this within perl's core\n"; |
8 | exit 0; |
9 | } |
10 | } |
11 | |
b3f8c6ea |
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 | |
b2deda17 |
19 | my $WIN = $^O eq 'MSWin32'; |
b3f8c6ea |
20 | |
b2deda17 |
21 | if ($WIN) { |
b3f8c6ea |
22 | eval { require IPC::Run; IPC::Run->VERSION(0.83); 1; } or |
b2deda17 |
23 | plan skip_all => 'Win32 environments require IPC::Run 0.83 to complete this test'; |
b3f8c6ea |
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'); |
b2deda17 |
32 | my @base_cmd = ( $^X, "-Mblib=$blib", $script ); |
b3f8c6ea |
33 | |
34 | plan tests => 5; |
35 | |
36 | { |
37 | my ( $st, $out, $err ) = run_cmd; |
38 | is( $st, 0, 'status for usage call' ); |
b2deda17 |
39 | is( $out, $WIN ? undef : '' ); |
b3f8c6ea |
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 | |
b2deda17 |
61 | if ($WIN) { |
b3f8c6ea |
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 | } |