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; | |
098f0b12 RGS |
16 | |
17 | BEGIN { | |
a428795d | 18 | require './test.pl'; |
77ba2250 | 19 | skip_all_without_config(qw(d_pipe d_fork d_waitpid d_getppid)); |
bd5a473b | 20 | plan (8); |
098f0b12 RGS |
21 | } |
22 | ||
a428795d NC |
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"; | |
098f0b12 | 27 | |
a428795d NC |
28 | if ($pid) { |
29 | # parent | |
098f0b12 | 30 | close $w; |
a428795d NC |
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"); | |
185a8799 MK |
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 | } | |
a428795d | 43 | return $second; |
098f0b12 RGS |
44 | } |
45 | else { | |
a428795d NC |
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; | |
098f0b12 | 65 | } |
098f0b12 | 66 | } |
a428795d NC |
67 | |
68 | my $first = fork_and_retrieve("first"); | |
69 | my $second = fork_and_retrieve("second"); | |
185a8799 MK |
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 | } | |
bd5a473b | 74 | isnt ($first, $$, "And that new parent isn't this process"); |