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"); | |
185a8799 MK |
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 | } | |
a428795d | 49 | return $second; |
098f0b12 RGS |
50 | } |
51 | else { | |
a428795d NC |
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; | |
098f0b12 | 71 | } |
098f0b12 | 72 | } |
a428795d NC |
73 | |
74 | my $first = fork_and_retrieve("first"); | |
75 | my $second = fork_and_retrieve("second"); | |
185a8799 MK |
76 | SKIP: { |
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 | } | |
bd5a473b | 80 | isnt ($first, $$, "And that new parent isn't this process"); |