Move the require './test.pl' to the end of t/comp/hints.t
[p5sagit/p5-mst-13.2.git] / t / op / getppid.t
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
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     }
25     require './test.pl';
26     plan (8);
27 }
28
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";
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
74 my $first = fork_and_retrieve("first");
75 my $second = fork_and_retrieve("second");
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 }
80 isnt ($first, $$, "And that new parent isn't this process");