diff options
author | Nicholas Clark <nick@ccl4.org> | 2009-09-25 13:37:29 +0100 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2009-09-25 13:37:29 +0100 |
commit | fafe5ad5a7e57ca14cd0844db173f3a4d6c9e8de (patch) | |
tree | 986df99d21cddd44a0a93e2048d8ad761dbc3865 /cpan/Encode/t/piconv.t | |
parent | 321c358920f04a77dd5318e7d76f9526d684fd5c (diff) | |
download | perl-fafe5ad5a7e57ca14cd0844db173f3a4d6c9e8de.tar.gz |
Move Encode from ext/ to cpan/
Diffstat (limited to 'cpan/Encode/t/piconv.t')
-rw-r--r-- | cpan/Encode/t/piconv.t | 96 |
1 files changed, 96 insertions, 0 deletions
diff --git a/cpan/Encode/t/piconv.t b/cpan/Encode/t/piconv.t new file mode 100644 index 0000000000..d97bb2873d --- /dev/null +++ b/cpan/Encode/t/piconv.t @@ -0,0 +1,96 @@ +# +# $Id: piconv.t,v 0.2 2009/07/13 00:50:52 dankogai Exp $ +# + +use strict; +use FindBin; +use File::Spec; +use IPC::Open3 qw(open3); +use IO::Select; +use Test::More; + +my $WIN = $^O eq 'MSWin32'; + +if ($WIN) { + eval { require IPC::Run; IPC::Run->VERSION(0.83); 1; } or + plan skip_all => 'Win32 environments require IPC::Run 0.83 to complete this test'; +} + +sub run_cmd (;$$); + +my $blib = + File::Spec->rel2abs( + File::Spec->catdir( $FindBin::RealBin, File::Spec->updir, 'blib' ) ); +my $script = File::Spec->catdir($blib, 'script', 'piconv'); +my @base_cmd = ( $^X, ($ENV{PERL_CORE} ? () : "-Mblib=$blib"), $script ); + +plan tests => 5; + +{ + my ( $st, $out, $err ) = run_cmd; + is( $st, 0, 'status for usage call' ); + is( $out, $WIN ? undef : '' ); + like( $err, qr{^piconv}, 'usage' ); +} + +{ + my($st, $out, $err) = run_cmd [qw(-S foobar -f utf-8 -t ascii), $script]; + like($err, qr{unknown scheme.*fallback}i, 'warning for unknown scheme'); +} + +{ + my ( $st, $out, $err ) = run_cmd [qw(-f utf-8 -t ascii ./non-existing/file)]; + like( $err, qr{can't open}i ); +} + +sub run_cmd (;$$) { + my ( $args, $in ) = @_; + + my $out = "x" x 10_000; + $out = ""; + my $err = "x" x 10_000; + $err = ""; + + if ($WIN) { + IPC::Run->import(qw(run timeout)); + my @cmd; + if (defined $args) { + @cmd = (@base_cmd, @$args); + } else { + @cmd = @base_cmd; + } + run(\@cmd, \$in, \$out, \$err, timeout(10)); + my $st = $?; + $out = undef if ($out eq ''); + ( $st, $out, $err ); + } else { + $in ||= ''; + my ( $in_fh, $out_fh, $err_fh ); + use Symbol 'gensym'; + $err_fh = + gensym; # sigh... otherwise stderr gets just to $out_fh, not to $err_fh + my $pid = open3( $in_fh, $out_fh, $err_fh, @base_cmd, @$args ) + or die "Can't run @base_cmd @$args: $!"; + print $in_fh $in; + my $sel = IO::Select->new( $out_fh, $err_fh ); + + while ( my @ready = $sel->can_read ) { + for my $fh (@ready) { + if ( eof($fh) ) { + $sel->remove($fh); + last if !$sel->handles; + } + elsif ( $out_fh == $fh ) { + my $line = <$fh>; + $out .= $line; + } + elsif ( $err_fh == $fh ) { + my $line = <$fh>; + $err .= $line; + } + } + } + my $st = $?; + ( $st, $out, $err ); + } +} |