xref: /openbsd/gnu/usr.bin/perl/cpan/Encode/t/piconv.t (revision a6445c1d) 
1#
2# $Id: piconv.t,v 0.4 2013/02/18 02:23:56 dankogai Exp $
3#
4
5BEGIN {
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
12use strict;
13use FindBin;
14use File::Spec;
15use IPC::Open3 qw(open3);
16use IO::Select;
17use Test::More;
18
19my $WIN = $^O eq 'MSWin32';
20
21if ($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
26sub run_cmd (;$$);
27
28my $blib =
29  File::Spec->rel2abs(
30    File::Spec->catdir( $FindBin::RealBin, File::Spec->updir ) );
31my $script = File::Spec->catdir($blib, 'bin', 'piconv');
32my @base_cmd = ( $^X, "-Mblib=$blib", $script );
33
34plan 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
53sub 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}
104