1*b39c5158Smillert#! /usr/bin/perl -w 2*b39c5158Smillert 3*b39c5158SmillertBEGIN { 4*b39c5158Smillert my $inc = $ENV{PERL5LIB}; 5*b39c5158Smillert $inc = $ENV{PERLLIB} unless defined $inc; 6*b39c5158Smillert $inc = '' unless defined $inc; 7*b39c5158Smillert $ENV{PERL5LIB} = join ';', @INC, split /;/, $inc; 8*b39c5158Smillert} 9*b39c5158Smillert 10*b39c5158Smillertuse strict; 11*b39c5158Smillertuse Test::More tests => 11; 12*b39c5158Smillertuse OS2::Process; 13*b39c5158Smillert 14*b39c5158Smillertmy $cmd = <<'EOA'; 15*b39c5158Smillertuse OS2::Process; 16*b39c5158Smillert$| = 1; 17*b39c5158Smillertprint for $$, ppid, sidOf; 18*b39c5158Smillert$SIG{TERM} = $SIG{INT} = sub {exit}; 19*b39c5158Smillertsleep 10; 20*b39c5158SmillertEOA 21*b39c5158Smillert 22*b39c5158Smillert#my $PID = open my $fh, '-|', $^X, '-wle', $cmd; 23*b39c5158Smillert$ENV{CMD_RUN} = $cmd; 24*b39c5158Smillertmy $PID = open my $fh, '-|', "$^X -wle 'eval \$ENV{CMD_RUN} or die'"; 25*b39c5158Smillertok $PID, 'opened a pipe'; 26*b39c5158Smillertmy ($kpid, $kppid, $sid); 27*b39c5158Smillert$kpid = <$fh>; 28*b39c5158Smillert$kppid = <$fh>; 29*b39c5158Smillert$sid = <$fh>; 30*b39c5158Smillertchomp ($kpid, $kppid, $sid); 31*b39c5158Smillert 32*b39c5158Smillert# This does not work with the intervening shell... 33*b39c5158Smillertmy $extra_fork = $kppid == $PID; # Temporary implementation of multi-arg open() 34*b39c5158Smillert 35*b39c5158Smillertprint "# us=$$, immediate-pid=$PID, parent-of-kid=$kppid, kid=$kpid\n"; 36*b39c5158Smillertif ($ENV{CMD_RUN}) { # Two copies of the shell intervene... 37*b39c5158Smillert is( ppidOf($kppid), $PID, 'correct pid of the kid or its parent'); 38*b39c5158Smillert is( ppidOf($PID), $$, 'we know our child\'s parent'); 39*b39c5158Smillert} else { 40*b39c5158Smillert is( ($extra_fork ? $kppid : $kpid), $PID, 'correct pid of the kid'); 41*b39c5158Smillert is( $kppid, ($extra_fork ? $PID : $$), 'kid knows its ppid'); 42*b39c5158Smillert} 43*b39c5158Smillertok $sid >= 0, 'kid got its sid'; 44*b39c5158Smillertis($sid, sidOf, 'sid of kid same as our'); 45*b39c5158Smillertis(sidOf($kpid), $sid, 'we know sid of kid'); 46*b39c5158Smillertis(sidOf($PID), $sid, 'we know sid of inter-kid'); 47*b39c5158Smillertis(ppidOf($kpid), $kppid, 'we know ppid of kid'); 48*b39c5158Smillertis(ppidOf($PID), $$, 'we know ppid of inter-kid'); 49*b39c5158Smillert 50*b39c5158Smillertok kill('TERM', $kpid), 'killed the kid'; 51*b39c5158Smillert#ok( ($PID == $kpid or kill('TERM', $PID)), 'killed the inter-kid'); 52*b39c5158Smillertok close $fh, 'closed the pipe'; # No kid any more 53