This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move tests for $[ from comp/hints.t to op/array_base.t
[perl5.git] / t / op / getppid.t
CommitLineData
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
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 }
a428795d 25 require './test.pl';
bd5a473b 26 plan (8);
098f0b12
RGS
27}
28
a428795d
NC
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";
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
74my $first = fork_and_retrieve("first");
75my $second = fork_and_retrieve("second");
185a8799
MK
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}
bd5a473b 80isnt ($first, $$, "And that new parent isn't this process");