#!/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" );