1#!./perl -w 2 3BEGIN { 4 require Config; import Config; 5 if (!$Config{'d_fork'} 6 # open2/3 supported on win32 7 && $^O ne 'MSWin32' && $^O ne 'NetWare') 8 { 9 print "1..0\n"; 10 exit 0; 11 } 12 # make warnings fatal 13 $SIG{__WARN__} = sub { die @_ }; 14} 15 16use strict; 17use Test::More tests => 38; 18 19use IO::Handle; 20use IPC::Open3; 21use POSIX ":sys_wait_h"; 22 23my $perl = $^X; 24 25sub cmd_line { 26 if ($^O eq 'MSWin32' || $^O eq 'NetWare') { 27 my $cmd = shift; 28 $cmd =~ tr/\r\n//d; 29 $cmd =~ s/"/\\"/g; 30 return qq/"$cmd"/; 31 } 32 else { 33 return $_[0]; 34 } 35} 36 37my ($pid, $reaped_pid); 38STDOUT->autoflush; 39STDERR->autoflush; 40 41# basic 42$pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', cmd_line(<<'EOF'); 43 $| = 1; 44 print scalar <STDIN>; 45 print STDERR "hi error\n"; 46EOF 47cmp_ok($pid, '!=', 0); 48isnt((print WRITE "hi kid\n"), 0); 49like(scalar <READ>, qr/^hi kid\r?\n$/); 50like(scalar <ERROR>, qr/^hi error\r?\n$/); 51is(close(WRITE), 1) or diag($!); 52is(close(READ), 1) or diag($!); 53is(close(ERROR), 1) or diag($!); 54$reaped_pid = waitpid $pid, 0; 55is($reaped_pid, $pid); 56is($?, 0); 57 58my $desc = "read and error together, both named"; 59$pid = open3 'WRITE', 'READ', 'READ', $perl, '-e', cmd_line(<<'EOF'); 60 $| = 1; 61 print scalar <STDIN>; 62 print STDERR scalar <STDIN>; 63EOF 64print WRITE "$desc\n"; 65like(scalar <READ>, qr/\A$desc\r?\n\z/); 66print WRITE "$desc [again]\n"; 67like(scalar <READ>, qr/\A$desc \[again\]\r?\n\z/); 68waitpid $pid, 0; 69 70$desc = "read and error together, error empty"; 71$pid = open3 'WRITE', 'READ', '', $perl, '-e', cmd_line(<<'EOF'); 72 $| = 1; 73 print scalar <STDIN>; 74 print STDERR scalar <STDIN>; 75EOF 76print WRITE "$desc\n"; 77like(scalar <READ>, qr/\A$desc\r?\n\z/); 78print WRITE "$desc [again]\n"; 79like(scalar <READ>, qr/\A$desc \[again\]\r?\n\z/); 80waitpid $pid, 0; 81 82is(pipe(PIPE_READ, PIPE_WRITE), 1); 83$pid = open3 '<&PIPE_READ', 'READ', '', 84 $perl, '-e', cmd_line('print scalar <STDIN>'); 85close PIPE_READ; 86print PIPE_WRITE "dup writer\n"; 87close PIPE_WRITE; 88like(scalar <READ>, qr/\Adup writer\r?\n\z/); 89waitpid $pid, 0; 90 91my $TB = Test::Builder->new(); 92my $test = $TB->current_test; 93# dup reader 94$pid = open3 'WRITE', '>&STDOUT', 'ERROR', 95 $perl, '-e', cmd_line('print scalar <STDIN>'); 96++$test; 97print WRITE "ok $test\n"; 98waitpid $pid, 0; 99 100{ 101 package YAAH; 102 $pid = IPC::Open3::open3('QWACK_WAAK_WAAK', '>&STDOUT', 'ERROR', 103 $perl, '-e', main::cmd_line('print scalar <STDIN>')); 104 ++$test; 105 no warnings 'once'; 106 print QWACK_WAAK_WAAK "ok $test # filenames qualified to their package\n"; 107 waitpid $pid, 0; 108} 109 110# dup error: This particular case, duping stderr onto the existing 111# stdout but putting stdout somewhere else, is a good case because it 112# used not to work. 113$pid = open3 'WRITE', 'READ', '>&STDOUT', 114 $perl, '-e', cmd_line('print STDERR scalar <STDIN>'); 115++$test; 116print WRITE "ok $test\n"; 117waitpid $pid, 0; 118 119foreach (['>&STDOUT', 'both named'], 120 ['', 'error empty'], 121 ) { 122 my ($err, $desc) = @$_; 123 $pid = open3 'WRITE', '>&STDOUT', $err, $perl, '-e', cmd_line(<<'EOF'); 124 $| = 1; 125 print STDOUT scalar <STDIN>; 126 print STDERR scalar <STDIN>; 127EOF 128 printf WRITE "ok %d # dup reader and error together, $desc\n", ++$test 129 for 0, 1; 130 waitpid $pid, 0; 131} 132 133# command line in single parameter variant of open3 134# for understanding of Config{'sh'} test see exec description in camel book 135my $cmd = 'print(scalar(<STDIN>))'; 136$cmd = $Config{'sh'} =~ /sh/ ? "'$cmd'" : cmd_line($cmd); 137$pid = eval { open3 'WRITE', '>&STDOUT', 'ERROR', "$perl -e " . $cmd; }; 138if ($@) { 139 print "error $@\n"; 140 ++$test; 141 print WRITE "not ok $test\n"; 142} 143else { 144 ++$test; 145 print WRITE "ok $test\n"; 146 waitpid $pid, 0; 147} 148$TB->current_test($test); 149 150# RT 72016 151{ 152 local $::TODO = "$^O returns a pid and doesn't throw an exception" 153 if $^O eq 'MSWin32'; 154 $pid = eval { open3 'WRITE', 'READ', 'ERROR', '/non/existent/program'; }; 155 isnt($@, '', 156 'open3 of a non existent program fails with an exception in the parent') 157 or do {waitpid $pid, 0}; 158 SKIP: { 159 skip 'open3 returned, our responsibility to reap', 1 unless $@; 160 is(waitpid(-1, WNOHANG), -1, 'failed exec child is reaped'); 161 } 162} 163 164$pid = eval { open3 'WRITE', '', 'ERROR', '/non/existent/program'; }; 165like($@, qr/^open3: Modification of a read-only value attempted at /, 166 'open3 faults read-only parameters correctly') or do {waitpid $pid, 0}; 167 168foreach my $handle (qw (DUMMY STDIN STDOUT STDERR)) { 169 local $::{$handle}; 170 my $out = IO::Handle->new(); 171 my $pid = eval { 172 local $SIG{__WARN__} = sub { 173 open my $fh, '>/dev/tty'; 174 return if "@_" =~ m!^Use of uninitialized value \$fd.*IO/Handle\.pm!; 175 print $fh "@_"; 176 die @_ 177 }; 178 open3 undef, $out, undef, $perl, '-le', "print q _# ${handle}_" 179 }; 180 is($@, '', "No errors with localised $handle"); 181 cmp_ok($pid, '>', 0, "Got a pid with localised $handle"); 182 if ($handle eq 'STDOUT') { 183 is(<$out>, undef, "Expected no output with localised $handle"); 184 } else { 185 like(<$out>, qr/\A# $handle\r?\n\z/, 186 "Expected output with localised $handle"); 187 } 188 waitpid $pid, 0; 189} 190