| 1 | #!/usr/bin/perl -w |
| 2 | |
| 3 | =head1 NAME |
| 4 | |
| 5 | binary.t - Test suite for IPC::Run binary functionality |
| 6 | |
| 7 | =cut |
| 8 | |
| 9 | BEGIN { |
| 10 | if( $ENV{PERL_CORE} ) { |
| 11 | use Cwd; |
| 12 | $^X = Cwd::abs_path($^X); |
| 13 | $^X = qq("$^X") if $^X =~ /\s/; |
| 14 | chdir '../lib/IPC/Run' if -d '../lib/IPC/Run'; |
| 15 | unshift @INC, 'lib', '../..'; |
| 16 | } |
| 17 | } |
| 18 | |
| 19 | ## Handy to have when our output is intermingled with debugging output sent |
| 20 | ## to the debugging fd. |
| 21 | $| = 1 ; |
| 22 | select STDERR ; $| = 1 ; select STDOUT ; |
| 23 | |
| 24 | use strict ; |
| 25 | |
| 26 | use Test ; |
| 27 | |
| 28 | use IPC::Run qw( harness run binary ) ; |
| 29 | |
| 30 | sub Win32_MODE() ; |
| 31 | *Win32_MODE = \&IPC::Run::Win32_MODE ; |
| 32 | |
| 33 | my $crlf_text = "Hello World\r\n" ; |
| 34 | |
| 35 | my $text = $crlf_text ; |
| 36 | $text =~ s/\r//g if Win32_MODE ; |
| 37 | |
| 38 | my $nl_text = $crlf_text ; |
| 39 | $nl_text =~ s/\r//g ; |
| 40 | |
| 41 | my @perl = ( $^X ) ; |
| 42 | |
| 43 | my $emitter_script = q{ binmode STDOUT ; print "Hello World\r\n" } ; |
| 44 | my @emitter = ( @perl, '-e', $emitter_script ) ; |
| 45 | |
| 46 | my $reporter_script = |
| 47 | q{ binmode STDIN ; $_ = join "", <>; s/([\000-\037])/sprintf "\\\\0x%02x", ord $1/ge; print } ; |
| 48 | my @reporter = ( @perl, '-e', $reporter_script ) ; |
| 49 | |
| 50 | my $in ; |
| 51 | my $out ; |
| 52 | my $err ; |
| 53 | |
| 54 | sub f($) { |
| 55 | my $s = shift ; |
| 56 | $s =~ s/([\000-\027])/sprintf "\\0x%02x", ord $1/ge ; |
| 57 | $s |
| 58 | } |
| 59 | |
| 60 | my @tests = ( |
| 61 | ## Parsing tests |
| 62 | sub { ok eval { harness [], '>', binary, \$out } ? 1 : $@, 1 } , |
| 63 | sub { ok eval { harness [], '>', binary, "foo" } ? 1 : $@, 1 }, |
| 64 | sub { ok eval { harness [], '<', binary, \$in } ? 1 : $@, 1 }, |
| 65 | sub { ok eval { harness [], '<', binary, "foo" } ? 1 : $@, 1 }, |
| 66 | |
| 67 | ## Testing from-kid now so we can use it to test stdin later |
| 68 | sub { ok run \@emitter, ">", \$out }, |
| 69 | sub { ok f $out, f $text, "no binary" }, |
| 70 | |
| 71 | sub { ok run \@emitter, ">", binary, \$out }, |
| 72 | sub { ok f $out, f $crlf_text, "out binary" }, |
| 73 | |
| 74 | sub { ok run \@emitter, ">", binary( 0 ), \$out }, |
| 75 | sub { ok f $out, f $text, "out binary 0" }, |
| 76 | |
| 77 | sub { ok run \@emitter, ">", binary( 1 ), \$out }, |
| 78 | sub { ok f $out, f $crlf_text, "out binary 1" }, |
| 79 | |
| 80 | ## Test to-kid |
| 81 | sub { ok run \@reporter, "<", \$nl_text, ">", \$out }, |
| 82 | sub { ok $out, "Hello World" . ( Win32_MODE ? "\\0x0d" : "" ) . "\\0x0a", "reporter < \\n" }, |
| 83 | |
| 84 | sub { ok run \@reporter, "<", binary, \$nl_text, ">", \$out }, |
| 85 | sub { ok $out, "Hello World\\0x0a", "reporter < binary \\n" }, |
| 86 | |
| 87 | sub { ok run \@reporter, "<", binary, \$crlf_text, ">", \$out }, |
| 88 | sub { ok $out, "Hello World\\0x0d\\0x0a", "reporter < binary \\r\\n" }, |
| 89 | |
| 90 | sub { ok run \@reporter, "<", binary( 0 ), \$nl_text, ">", \$out }, |
| 91 | sub { ok $out, "Hello World" . ( Win32_MODE ? "\\0x0d" : "" ) . "\\0x0a", "reporter < binary(0) \\n" }, |
| 92 | |
| 93 | sub { ok run \@reporter, "<", binary( 1 ), \$nl_text, ">", \$out }, |
| 94 | sub { ok $out, "Hello World\\0x0a", "reporter < binary(1) \\n" }, |
| 95 | |
| 96 | sub { ok run \@reporter, "<", binary( 1 ), \$crlf_text, ">", \$out }, |
| 97 | sub { ok $out, "Hello World\\0x0d\\0x0a", "reporter < binary(1) \\r\\n" }, |
| 98 | ) ; |
| 99 | |
| 100 | plan tests => scalar @tests ; |
| 101 | |
| 102 | $_->() for ( @tests ) ; |