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 10BEGIN { 11 chdir 't' if -d 't'; 12 @INC = qw(../lib); 13} 14 15use strict; 16use Config; 17 18BEGIN { 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 29sub 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 SKIP: { 44 skip("Orphan processes are not reparented on QNX", 1) 45 if $^O eq 'nto'; 46 isnt($first, $second, 47 "Orphaned $which grandchild got a new parent"); 48 } 49 return $second; 50 } 51 else { 52 # child 53 # Prevent test.pl from thinking that we failed to run any tests. 54 $::NO_ENDING = 1; 55 close $r; 56 57 my $pid2 = fork; defined $pid2 or die "fork: $!\n"; 58 if ($pid2) { 59 close $w; 60 sleep 1; 61 } 62 else { 63 # grandchild 64 my $ppid1 = getppid(); 65 # Wait for immediate parent to exit 66 sleep 2; 67 my $ppid2 = getppid(); 68 print $w "$ppid1,$ppid2\n"; 69 } 70 exit 0; 71 } 72} 73 74my $first = fork_and_retrieve("first"); 75my $second = fork_and_retrieve("second"); 76SKIP: { 77 skip ("Orphan processes are not reparented on QNX", 1) if $^O eq 'nto'; 78 is ($first, $second, "Both orphaned grandchildren get the same new parent"); 79} 80isnt ($first, $$, "And that new parent isn't this process"); 81