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 use Config;
  17
  18 BEGIN {
  19     for my $syscall (qw(pipe fork waitpid getppid)) {
  20         if (!$Config{"d_$syscall"}) {
  21             print "1..0 # Skip: no $syscall\n";
  22             exit;
  23         }
  24     }
  25     require './test.pl';
  26     plan (8);
  27 }
  28
  29 sub fork_and_retrieve {
  30     my $which = shift;
  31     pipe my ($r, $w) or die "pipe: $!\n";
  32     my $pid = fork; defined $pid or die "fork: $!\n";
  33
  34     if ($pid) {
  35         # parent
  36         close $w;
  37         $_ = <$r>;
  38         chomp;
  39         die "Garbled output '$_'"
  40             unless my ($first, $second) = /^(\d+),(\d+)\z/;
  41         cmp_ok ($first, '>=', 1, "Parent of $which grandchild");
  42         cmp_ok ($second, '>=', 1, "New parent of orphaned $which grandchild");
  43         isnt($first, $second, "Orphaned $which grandchild got a new parent");
  44         return $second;
  45     }
  46     else {
  47         # child
  48         # Prevent test.pl from thinking that we failed to run any tests.
  49         $::NO_ENDING = 1;
  50         close $r;
  51
  52         my $pid2 = fork; defined $pid2 or die "fork: $!\n";
  53         if ($pid2) {
  54             close $w;
  55             sleep 1;
  56         }
  57         else {
  58             # grandchild
  59             my $ppid1 = getppid();
  60             # Wait for immediate parent to exit
  61             sleep 2;
  62             my $ppid2 = getppid();
  63             print $w "$ppid1,$ppid2\n";
  64         }
  65         exit 0;
  66     }
  67 }
  68
  69 my $first = fork_and_retrieve("first");
  70 my $second = fork_and_retrieve("second");
  71 is ($first, $second, "Both orphaned grandchildren get the same new parent");
  72 isnt ($first, $$, "And that new parent isn't this process");