1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate chdir 't' if -d 't'; 5*0Sstevel@tonic-gate @INC = '../lib'; 6*0Sstevel@tonic-gate require Config; import Config; 7*0Sstevel@tonic-gate require './test.pl'; 8*0Sstevel@tonic-gate 9*0Sstevel@tonic-gate if (!$Config{'d_fork'}) { 10*0Sstevel@tonic-gate skip_all("fork required to pipe"); 11*0Sstevel@tonic-gate } 12*0Sstevel@tonic-gate else { 13*0Sstevel@tonic-gate plan(tests => 22); 14*0Sstevel@tonic-gate } 15*0Sstevel@tonic-gate} 16*0Sstevel@tonic-gate 17*0Sstevel@tonic-gatemy $Perl = which_perl(); 18*0Sstevel@tonic-gate 19*0Sstevel@tonic-gate 20*0Sstevel@tonic-gate$| = 1; 21*0Sstevel@tonic-gate 22*0Sstevel@tonic-gateopen(PIPE, "|-") || exec $Perl, '-pe', 'tr/YX/ko/'; 23*0Sstevel@tonic-gate 24*0Sstevel@tonic-gateprintf PIPE "Xk %d - open |- || exec\n", curr_test(); 25*0Sstevel@tonic-gatenext_test(); 26*0Sstevel@tonic-gateprintf PIPE "oY %d - again\n", curr_test(); 27*0Sstevel@tonic-gatenext_test(); 28*0Sstevel@tonic-gateclose PIPE; 29*0Sstevel@tonic-gate 30*0Sstevel@tonic-gateSKIP: { 31*0Sstevel@tonic-gate # Technically this should be TODO. Someone try it if you happen to 32*0Sstevel@tonic-gate # have a vmesa machine. 33*0Sstevel@tonic-gate skip "Doesn't work here yet", 4 if $^O eq 'vmesa'; 34*0Sstevel@tonic-gate 35*0Sstevel@tonic-gate if (open(PIPE, "-|")) { 36*0Sstevel@tonic-gate while(<PIPE>) { 37*0Sstevel@tonic-gate s/^not //; 38*0Sstevel@tonic-gate print; 39*0Sstevel@tonic-gate } 40*0Sstevel@tonic-gate close PIPE; # avoid zombies 41*0Sstevel@tonic-gate } 42*0Sstevel@tonic-gate else { 43*0Sstevel@tonic-gate printf STDOUT "not ok %d - open -|\n", curr_test(); 44*0Sstevel@tonic-gate next_test(); 45*0Sstevel@tonic-gate my $tnum = curr_test; 46*0Sstevel@tonic-gate next_test(); 47*0Sstevel@tonic-gate exec $Perl, '-le', "print q{not ok $tnum - again}"; 48*0Sstevel@tonic-gate } 49*0Sstevel@tonic-gate 50*0Sstevel@tonic-gate # This has to be *outside* the fork 51*0Sstevel@tonic-gate next_test() for 1..2; 52*0Sstevel@tonic-gate 53*0Sstevel@tonic-gate SKIP: { 54*0Sstevel@tonic-gate skip "fork required", 2 unless $Config{d_fork}; 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gate pipe(READER,WRITER) || die "Can't open pipe"; 57*0Sstevel@tonic-gate 58*0Sstevel@tonic-gate if ($pid = fork) { 59*0Sstevel@tonic-gate close WRITER; 60*0Sstevel@tonic-gate while(<READER>) { 61*0Sstevel@tonic-gate s/^not //; 62*0Sstevel@tonic-gate y/A-Z/a-z/; 63*0Sstevel@tonic-gate print; 64*0Sstevel@tonic-gate } 65*0Sstevel@tonic-gate close READER; # avoid zombies 66*0Sstevel@tonic-gate } 67*0Sstevel@tonic-gate else { 68*0Sstevel@tonic-gate die "Couldn't fork" unless defined $pid; 69*0Sstevel@tonic-gate close READER; 70*0Sstevel@tonic-gate printf WRITER "not ok %d - pipe & fork\n", curr_test; 71*0Sstevel@tonic-gate next_test; 72*0Sstevel@tonic-gate 73*0Sstevel@tonic-gate open(STDOUT,">&WRITER") || die "Can't dup WRITER to STDOUT"; 74*0Sstevel@tonic-gate close WRITER; 75*0Sstevel@tonic-gate 76*0Sstevel@tonic-gate my $tnum = curr_test; 77*0Sstevel@tonic-gate next_test; 78*0Sstevel@tonic-gate exec $Perl, '-le', "print q{not ok $tnum - with fh dup }"; 79*0Sstevel@tonic-gate } 80*0Sstevel@tonic-gate 81*0Sstevel@tonic-gate # This has to be done *outside* the fork. 82*0Sstevel@tonic-gate next_test() for 1..2; 83*0Sstevel@tonic-gate } 84*0Sstevel@tonic-gate} 85*0Sstevel@tonic-gatewait; # Collect from $pid 86*0Sstevel@tonic-gate 87*0Sstevel@tonic-gatepipe(READER,WRITER) || die "Can't open pipe"; 88*0Sstevel@tonic-gateclose READER; 89*0Sstevel@tonic-gate 90*0Sstevel@tonic-gate$SIG{'PIPE'} = 'broken_pipe'; 91*0Sstevel@tonic-gate 92*0Sstevel@tonic-gatesub broken_pipe { 93*0Sstevel@tonic-gate $SIG{'PIPE'} = 'IGNORE'; # loop preventer 94*0Sstevel@tonic-gate printf "ok %d - SIGPIPE\n", curr_test; 95*0Sstevel@tonic-gate} 96*0Sstevel@tonic-gate 97*0Sstevel@tonic-gateprintf WRITER "not ok %d - SIGPIPE\n", curr_test; 98*0Sstevel@tonic-gateclose WRITER; 99*0Sstevel@tonic-gatesleep 1; 100*0Sstevel@tonic-gatenext_test; 101*0Sstevel@tonic-gatepass(); 102*0Sstevel@tonic-gate 103*0Sstevel@tonic-gate# VMS doesn't like spawning subprocesses that are still connected to 104*0Sstevel@tonic-gate# STDOUT. Someone should modify these tests to work with VMS. 105*0Sstevel@tonic-gate 106*0Sstevel@tonic-gateSKIP: { 107*0Sstevel@tonic-gate skip "doesn't like spawning subprocesses that are still connected", 10 108*0Sstevel@tonic-gate if $^O eq 'VMS'; 109*0Sstevel@tonic-gate 110*0Sstevel@tonic-gate SKIP: { 111*0Sstevel@tonic-gate # Sfio doesn't report failure when closing a broken pipe 112*0Sstevel@tonic-gate # that has pending output. Go figure. MachTen doesn't either, 113*0Sstevel@tonic-gate # but won't write to broken pipes, so nothing's pending at close. 114*0Sstevel@tonic-gate # BeOS will not write to broken pipes, either. 115*0Sstevel@tonic-gate # Nor does POSIX-BC. 116*0Sstevel@tonic-gate skip "Won't report failure on broken pipe", 1 117*0Sstevel@tonic-gate if $Config{d_sfio} || $^O eq 'machten' || $^O eq 'beos' || 118*0Sstevel@tonic-gate $^O eq 'posix-bc'; 119*0Sstevel@tonic-gate 120*0Sstevel@tonic-gate local $SIG{PIPE} = 'IGNORE'; 121*0Sstevel@tonic-gate open NIL, qq{|$Perl -e "exit 0"} or die "open failed: $!"; 122*0Sstevel@tonic-gate sleep 5; 123*0Sstevel@tonic-gate if (print NIL 'foo') { 124*0Sstevel@tonic-gate # If print was allowed we had better get an error on close 125*0Sstevel@tonic-gate ok( !close NIL, 'close error on broken pipe' ); 126*0Sstevel@tonic-gate } 127*0Sstevel@tonic-gate else { 128*0Sstevel@tonic-gate ok(close NIL, 'print failed on broken pipe'); 129*0Sstevel@tonic-gate } 130*0Sstevel@tonic-gate } 131*0Sstevel@tonic-gate 132*0Sstevel@tonic-gate SKIP: { 133*0Sstevel@tonic-gate skip "Don't work yet", 9 if $^O eq 'vmesa'; 134*0Sstevel@tonic-gate 135*0Sstevel@tonic-gate # check that errno gets forced to 0 if the piped program exited 136*0Sstevel@tonic-gate # non-zero 137*0Sstevel@tonic-gate open NIL, qq{|$Perl -e "exit 23";} or die "fork failed: $!"; 138*0Sstevel@tonic-gate $! = 1; 139*0Sstevel@tonic-gate ok(!close NIL, 'close failure on non-zero piped exit'); 140*0Sstevel@tonic-gate is($!, '', ' errno'); 141*0Sstevel@tonic-gate isnt($?, 0, ' status'); 142*0Sstevel@tonic-gate 143*0Sstevel@tonic-gate SKIP: { 144*0Sstevel@tonic-gate skip "Don't work yet", 6 if $^O eq 'mpeix'; 145*0Sstevel@tonic-gate 146*0Sstevel@tonic-gate # check that status for the correct process is collected 147*0Sstevel@tonic-gate my $zombie; 148*0Sstevel@tonic-gate unless( $zombie = fork ) { 149*0Sstevel@tonic-gate $NO_ENDING=1; 150*0Sstevel@tonic-gate exit 37; 151*0Sstevel@tonic-gate } 152*0Sstevel@tonic-gate my $pipe = open *FH, "sleep 2;exit 13|" or die "Open: $!\n"; 153*0Sstevel@tonic-gate $SIG{ALRM} = sub { return }; 154*0Sstevel@tonic-gate alarm(1); 155*0Sstevel@tonic-gate is( close FH, '', 'close failure for... umm, something' ); 156*0Sstevel@tonic-gate is( $?, 13*256, ' status' ); 157*0Sstevel@tonic-gate is( $!, '', ' errno'); 158*0Sstevel@tonic-gate 159*0Sstevel@tonic-gate my $wait = wait; 160*0Sstevel@tonic-gate is( $?, 37*256, 'status correct after wait' ); 161*0Sstevel@tonic-gate is( $wait, $zombie, ' wait pid' ); 162*0Sstevel@tonic-gate is( $!, '', ' errno'); 163*0Sstevel@tonic-gate } 164*0Sstevel@tonic-gate } 165*0Sstevel@tonic-gate} 166*0Sstevel@tonic-gate 167*0Sstevel@tonic-gate# Test new semantics for missing command in piped open 168*0Sstevel@tonic-gate# 19990114 M-J. Dominus mjd@plover.com 169*0Sstevel@tonic-gate{ local *P; 170*0Sstevel@tonic-gate ok( !open(P, "| "), 'missing command in piped open input' ); 171*0Sstevel@tonic-gate ok( !open(P, " |"), ' output'); 172*0Sstevel@tonic-gate} 173*0Sstevel@tonic-gate 174*0Sstevel@tonic-gate# check that status is unaffected by implicit close 175*0Sstevel@tonic-gate{ 176*0Sstevel@tonic-gate local(*NIL); 177*0Sstevel@tonic-gate open NIL, qq{|$Perl -e "exit 23"} or die "fork failed: $!"; 178*0Sstevel@tonic-gate $? = 42; 179*0Sstevel@tonic-gate # NIL implicitly closed here 180*0Sstevel@tonic-gate} 181*0Sstevel@tonic-gateis($?, 42, 'status unaffected by implicit close'); 182*0Sstevel@tonic-gate$? = 0; 183*0Sstevel@tonic-gate 184*0Sstevel@tonic-gate# check that child is reaped if the piped program can't be executed 185*0Sstevel@tonic-gate{ 186*0Sstevel@tonic-gate open NIL, '/no_such_process |'; 187*0Sstevel@tonic-gate close NIL; 188*0Sstevel@tonic-gate 189*0Sstevel@tonic-gate my $child = 0; 190*0Sstevel@tonic-gate eval { 191*0Sstevel@tonic-gate local $SIG{ALRM} = sub { die; }; 192*0Sstevel@tonic-gate alarm 2; 193*0Sstevel@tonic-gate $child = wait; 194*0Sstevel@tonic-gate alarm 0; 195*0Sstevel@tonic-gate }; 196*0Sstevel@tonic-gate 197*0Sstevel@tonic-gate is($child, -1, 'child reaped if piped program cannot be executed'); 198*0Sstevel@tonic-gate} 199