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