#!/usr/bin/perl
=pod
=head1 NAME
binary.t - Test suite for IPC::Run binary functionality
=cut
use strict;
BEGIN {
$| = 1;
$^W = 1;
if( $ENV{PERL_CORE} ) {
chdir '../lib/IPC/Run' if -d '../lib/IPC/Run';
unshift @INC, 'lib', '../..';
$^X = '../../../t/' . $^X;
}
}
## Handy to have when our output is intermingled with debugging output sent
## to the debugging fd.
select STDERR;
select STDOUT;
use Test::More tests => 24;
use IPC::Run qw( harness run binary );
sub Win32_MODE();
*Win32_MODE = \&IPC::Run::Win32_MODE;
my $crlf_text = "Hello World\r\n";
my $text = $crlf_text;
$text =~ s/\r//g if Win32_MODE;
my $nl_text = $crlf_text;
$nl_text =~ s/\r//g;
my @perl = ( $^X );
my $emitter_script = q{ binmode STDOUT; print "Hello World\r\n" };
my @emitter = ( @perl, '-e', $emitter_script );
my $reporter_script =
q{ binmode STDIN; $_ = join "", <>; s/([\000-\037])/sprintf "\\\\0x%02x", ord $1/ge; print };
my @reporter = ( @perl, '-e', $reporter_script );
my $in;
my $out;
my $err;
sub f($) {
my $s = shift;
$s =~ s/([\000-\027])/sprintf "\\0x%02x", ord $1/ge;
$s
}
## Parsing tests
is( eval { harness [], '>', binary, \$out } ? 1 : $@, 1 );
is( eval { harness [], '>', binary, "foo" } ? 1 : $@, 1 );
is( eval { harness [], '<', binary, \$in } ? 1 : $@, 1 );
is( eval { harness [], '<', binary, "foo" } ? 1 : $@, 1 );
## Testing from-kid now so we can use it to test stdin later
ok( run( \@emitter, ">", \$out ) );
is( f($out), f($text), "no binary" );
ok( run( \@emitter, ">", binary, \$out ) );
is( f($out), f($crlf_text), "out binary" );
ok( run( \@emitter, ">", binary( 0 ), \$out ) );
is( f($out), f($text), "out binary 0" );
ok( run( \@emitter, ">", binary( 1 ), \$out ) );
is( f($out), f($crlf_text), "out binary 1" );
## Test to-kid
ok( run( \@reporter, "<", \$nl_text, ">", \$out ) );
is( $out, "Hello World" . ( Win32_MODE ? "\\0x0d" : "" ) . "\\0x0a", "reporter < \\n" );
ok( run( \@reporter, "<", binary, \$nl_text, ">", \$out ) );
is( $out, "Hello World\\0x0a", "reporter < binary \\n" );
ok( run( \@reporter, "<", binary, \$crlf_text, ">", \$out ) );
is( $out, "Hello World\\0x0d\\0x0a", "reporter < binary \\r\\n" );
ok( run( \@reporter, "<", binary( 0 ), \$nl_text, ">", \$out ) );
is( $out, "Hello World" . ( Win32_MODE ? "\\0x0d" : "" ) . "\\0x0a", "reporter < binary(0) \\n" );
ok( run( \@reporter, "<", binary( 1 ), \$nl_text, ">", \$out ) );
is( $out, "Hello World\\0x0a", "reporter < binary(1) \\n" );
ok( run( \@reporter, "<", binary( 1 ), \$crlf_text, ">", \$out ) );
is( $out, "Hello World\\0x0d\\0x0a", "reporter < binary(1) \\r\\n" );