Commit | Line | Data |
b3f8c6ea |
1 | # |
2 | # $Id: piconv.t,v 0.2 2009/07/13 00:50:52 dankogai Exp $ |
3 | # |
4 | |
b3f8c6ea |
5 | use strict; |
1518db69 |
6 | use Config; |
b3f8c6ea |
7 | use FindBin; |
8 | use File::Spec; |
9 | use IPC::Open3 qw(open3); |
10 | use IO::Select; |
11 | use Test::More; |
12 | |
1518db69 |
13 | my $nofork = ! $Config{d_fork}; |
b3f8c6ea |
14 | |
1518db69 |
15 | if ($nofork) { |
b3f8c6ea |
16 | eval { require IPC::Run; IPC::Run->VERSION(0.83); 1; } or |
1518db69 |
17 | plan skip_all => 'Without fork(), we require IPC::Run 0.83 to complete this test'; |
b3f8c6ea |
18 | } |
19 | |
20 | sub run_cmd (;$$); |
21 | |
22 | my $blib = |
23 | File::Spec->rel2abs( |
24 | File::Spec->catdir( $FindBin::RealBin, File::Spec->updir, 'blib' ) ); |
25 | my $script = File::Spec->catdir($blib, 'script', 'piconv'); |
0aeed650 |
26 | my @base_cmd = ( $^X, ($ENV{PERL_CORE} ? () : "-Mblib=$blib"), $script ); |
b3f8c6ea |
27 | |
28 | plan tests => 5; |
29 | |
30 | { |
31 | my ( $st, $out, $err ) = run_cmd; |
32 | is( $st, 0, 'status for usage call' ); |
1518db69 |
33 | is( $out, $nofork ? undef : '' ); |
b3f8c6ea |
34 | like( $err, qr{^piconv}, 'usage' ); |
35 | } |
36 | |
37 | { |
38 | my($st, $out, $err) = run_cmd [qw(-S foobar -f utf-8 -t ascii), $script]; |
39 | like($err, qr{unknown scheme.*fallback}i, 'warning for unknown scheme'); |
40 | } |
41 | |
42 | { |
43 | my ( $st, $out, $err ) = run_cmd [qw(-f utf-8 -t ascii ./non-existing/file)]; |
44 | like( $err, qr{can't open}i ); |
45 | } |
46 | |
47 | sub run_cmd (;$$) { |
48 | my ( $args, $in ) = @_; |
49 | |
50 | my $out = "x" x 10_000; |
51 | $out = ""; |
52 | my $err = "x" x 10_000; |
53 | $err = ""; |
54 | |
1518db69 |
55 | if ($nofork) { |
b3f8c6ea |
56 | IPC::Run->import(qw(run timeout)); |
57 | my @cmd; |
58 | if (defined $args) { |
59 | @cmd = (@base_cmd, @$args); |
60 | } else { |
61 | @cmd = @base_cmd; |
62 | } |
63 | run(\@cmd, \$in, \$out, \$err, timeout(10)); |
64 | my $st = $?; |
65 | $out = undef if ($out eq ''); |
66 | ( $st, $out, $err ); |
67 | } else { |
68 | $in ||= ''; |
69 | my ( $in_fh, $out_fh, $err_fh ); |
70 | use Symbol 'gensym'; |
71 | $err_fh = |
72 | gensym; # sigh... otherwise stderr gets just to $out_fh, not to $err_fh |
73 | my $pid = open3( $in_fh, $out_fh, $err_fh, @base_cmd, @$args ) |
74 | or die "Can't run @base_cmd @$args: $!"; |
75 | print $in_fh $in; |
76 | my $sel = IO::Select->new( $out_fh, $err_fh ); |
77 | |
78 | while ( my @ready = $sel->can_read ) { |
79 | for my $fh (@ready) { |
80 | if ( eof($fh) ) { |
81 | $sel->remove($fh); |
82 | last if !$sel->handles; |
83 | } |
84 | elsif ( $out_fh == $fh ) { |
85 | my $line = <$fh>; |
86 | $out .= $line; |
87 | } |
88 | elsif ( $err_fh == $fh ) { |
89 | my $line = <$fh>; |
90 | $err .= $line; |
91 | } |
92 | } |
93 | } |
94 | my $st = $?; |
95 | ( $st, $out, $err ); |
96 | } |
97 | } |