t/op/getppid.t

   1 #!./perl
   2
   3 # Test that getppid() follows UNIX semantics: when the parent process
   4 # dies, the child is reparented to the init process
   5 # The init process is usually 1, but doesn't have to be, and there's no
   6 # standard way to find out what it is, so the only portable way to go it so
   7 # attempt 2 reparentings and see if the PID both orphaned grandchildren get is
   8 # the same. (and not ours)
   9
  10 BEGIN {
  11     chdir 't' if -d 't';
  12     @INC = qw(../lib);
  13 }
  14
  15 use strict;
  16
  17 BEGIN {
  18     require './test.pl';
  19     skip_all_without_config(qw(d_pipe d_fork d_waitpid d_getppid));
  20     plan (8);
  21 }
  22
  23 sub fork_and_retrieve {
  24     my $which = shift;
  25     pipe my ($r, $w) or die "pipe: $!\n";
  26     my $pid = fork; defined $pid or die "fork: $!\n";
  27
  28     if ($pid) {
  29         # parent
  30         close $w;
  31         $_ = <$r>;
  32         chomp;
  33         die "Garbled output '$_'"
  34             unless my ($first, $second) = /^(\d+),(\d+)\z/;
  35         cmp_ok ($first, '>=', 1, "Parent of $which grandchild");
  36         cmp_ok ($second, '>=', 1, "New parent of orphaned $which grandchild");
  37         SKIP: {
  38             skip("Orphan processes are not reparented on QNX", 1)
  39                 if $^O eq 'nto';
  40             isnt($first, $second,
  41                  "Orphaned $which grandchild got a new parent");
  42         }
  43         return $second;
  44     }
  45     else {
  46         # child
  47         # Prevent test.pl from thinking that we failed to run any tests.
  48         $::NO_ENDING = 1;
  49         close $r;
  50
  51         my $pid2 = fork; defined $pid2 or die "fork: $!\n";
  52         if ($pid2) {
  53             close $w;
  54             sleep 1;
  55         }
  56         else {
  57             # grandchild
  58             my $ppid1 = getppid();
  59             # Wait for immediate parent to exit
  60             sleep 2;
  61             my $ppid2 = getppid();
  62             print $w "$ppid1,$ppid2\n";
  63         }
  64         exit 0;
  65     }
  66 }
  67
  68 my $first = fork_and_retrieve("first");
  69 my $second = fork_and_retrieve("second");
  70 SKIP: {
  71     skip ("Orphan processes are not reparented on QNX", 1) if $^O eq 'nto';
  72     is ($first, $second, "Both orphaned grandchildren get the same new parent");
  73 }
  74 isnt ($first, $$, "And that new parent isn't this process");