Commit | Line | Data |
---|---|---|
098f0b12 RGS |
1 | #!./perl |
2 | ||
3 | # Test that getppid() follows UNIX semantics: when the parent process | |
a428795d NC |
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) | |
098f0b12 RGS |
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 | } | |
a428795d | 25 | require './test.pl'; |
bd5a473b | 26 | plan (8); |
098f0b12 RGS |
27 | } |
28 | ||
a428795d NC |
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"; | |
098f0b12 | 33 | |
a428795d NC |
34 | if ($pid) { |
35 | # parent | |
098f0b12 | 36 | close $w; |
a428795d NC |
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; | |
098f0b12 RGS |
45 | } |
46 | else { | |
a428795d NC |
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; | |
098f0b12 | 66 | } |
098f0b12 | 67 | } |
a428795d NC |
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"); | |
bd5a473b | 72 | isnt ($first, $$, "And that new parent isn't this process"); |