Convert t/op/die_except.t to test.pl, strict and warnings.

[perl5.git] / t / op / getppid.t

diff --git a/t/op/getppid.t b/t/op/getppid.t
index cb48688..a631610 100644 (file)
--- a/t/op/getppid.t
+++ b/t/op/getppid.t
@@ -1,7 +1,11 @@
 #!./perl
 
 # Test that getppid() follows UNIX semantics: when the parent process
-# dies, the child is reparented to the init process (pid 1).
+# dies, the child is reparented to the init process
+# The init process is usually 1, but doesn't have to be, and there's no
+# standard way to find out what it is, so the only portable way to go it so
+# attempt 2 reparentings and see if the PID both orphaned grandchildren get is
+# the same. (and not ours)
 
 BEGIN {
     chdir 't' if -d 't';
@@ -9,46 +13,62 @@ BEGIN {
 }
 
 use strict;
-use Config;
 
 BEGIN {
-    for my $syscall (qw(pipe fork waitpid getppid)) {
-       if (!$Config{"d_$syscall"}) {
-           print "1..0 # Skip: no $syscall\n";
-           exit;
-       }
-    }
-    print "1..3\n";
+    require './test.pl';
+    skip_all_without_config(qw(d_pipe d_fork d_waitpid d_getppid));
+    plan (8);
 }
 
-pipe my ($r, $w) or die "pipe: $!\n";
-my $pid = fork; defined $pid or die "fork: $!\n";
+sub fork_and_retrieve {
+    my $which = shift;
+    pipe my ($r, $w) or die "pipe: $!\n";
+    my $pid = fork; defined $pid or die "fork: $!\n";
 
-if ($pid) {
-    # parent
-    close $w;
-    waitpid($pid, 0) == $pid or die "waitpid: $!\n";
-    print <$r>;
-}
-else {
-    # child
-    close $r;
-    my $pid2 = fork; defined $pid2 or die "fork: $!\n";
-    if ($pid2) {
+    if ($pid) {
+       # parent
        close $w;
-       sleep 1;
+       $_ = <$r>;
+       chomp;
+       die "Garbled output '$_'"
+           unless my ($first, $second) = /^(\d+),(\d+)\z/;
+       cmp_ok ($first, '>=', 1, "Parent of $which grandchild");
+       cmp_ok ($second, '>=', 1, "New parent of orphaned $which grandchild");
+       SKIP: {
+           skip("Orphan processes are not reparented on QNX", 1)
+               if $^O eq 'nto';
+           isnt($first, $second,
+                 "Orphaned $which grandchild got a new parent");
+       }
+       return $second;
     }
     else {
-       # grandchild
-       my $ppid1 = getppid();
-       print $w "not " if $ppid1 <= 1;
-       print $w "ok 1 # ppid1=$ppid1\n";
-       sleep 2;
-       my $ppid2 = getppid();
-       print $w "not " if $ppid1 == $ppid2;
-       print $w "ok 2 # ppid2=$ppid2, ppid1!=ppid2\n";
-       print $w "not " if $ppid2 != 1;
-       print $w "ok 3 # ppid2=1\n";
+       # child
+       # Prevent test.pl from thinking that we failed to run any tests.
+       $::NO_ENDING = 1;
+       close $r;
+
+       my $pid2 = fork; defined $pid2 or die "fork: $!\n";
+       if ($pid2) {
+           close $w;
+           sleep 1;
+       }
+       else {
+           # grandchild
+           my $ppid1 = getppid();
+           # Wait for immediate parent to exit
+           sleep 2;
+           my $ppid2 = getppid();
+           print $w "$ppid1,$ppid2\n";
+       }
+       exit 0;
     }
-    exit 0;
 }
+
+my $first = fork_and_retrieve("first");
+my $second = fork_and_retrieve("second");
+SKIP: {
+    skip ("Orphan processes are not reparented on QNX", 1) if $^O eq 'nto';
+    is ($first, $second, "Both orphaned grandchildren get the same new parent");
+}
+isnt ($first, $$, "And that new parent isn't this process");