Fix file_name_is_absolute on VMS for device without a directory.

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

diff --git a/t/op/getppid.t b/t/op/getppid.t
index 70c5a32..a8d0f2c 100644 (file)
--- a/t/op/getppid.t
+++ b/t/op/getppid.t
@@ -13,19 +13,16 @@ 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;
-       }
-    }
     require './test.pl';
+    skip_all_without_config(qw(d_pipe d_fork d_waitpid d_getppid));
     plan (8);
 }
 
+# No, we don't want any zombies. kill 0, $ppid spots zombies :-(
+$SIG{CHLD} = 'IGNORE';
+
 sub fork_and_retrieve {
     my $which = shift;
     pipe my ($r, $w) or die "pipe: $!\n";
@@ -33,34 +30,77 @@ sub fork_and_retrieve {
 
     if ($pid) {
        # parent
-       close $w;
+       close $w or die "close: $!\n";
        $_ = <$r>;
        chomp;
        die "Garbled output '$_'"
-           unless my ($first, $second) = /^(\d+),(\d+)\z/;
+           unless my ($how, $first, $second) = /^([a-z]+),(\d+),(\d+)\z/;
        cmp_ok ($first, '>=', 1, "Parent of $which grandchild");
-       cmp_ok ($second, '>=', 1, "New parent of orphaned $which grandchild");
-       isnt($first, $second, "Orphaned $which grandchild got a new parent");
+       my $message = "grandchild waited until '$how'";
+       cmp_ok ($second, '>=', 1, "New parent of orphaned $which grandchild")
+           ? note ($message) : diag ($message);
+
+       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 {
        # child
        # Prevent test.pl from thinking that we failed to run any tests.
        $::NO_ENDING = 1;
-       close $r;
+       close $r or die "close: $!\n";
 
+       pipe my ($r2, $w2) or die "pipe: $!\n";
+       pipe my ($r3, $w3) or die "pipe: $!\n";
        my $pid2 = fork; defined $pid2 or die "fork: $!\n";
        if ($pid2) {
-           close $w;
-           sleep 1;
+           close $w or die "close: $!\n";
+           close $w2 or die "close: $!\n";
+           close $r3 or die "close: $!\n";
+           # Wait for our child to signal that it's read our PID:
+           <$r2>;
+           # Implicit close of $w3:
+           exit 0;
        }
        else {
            # grandchild
+           close $r2 or die "close: $!\n";
+           close $w3 or die "close: $!\n";
            my $ppid1 = getppid();
-           # Wait for immediate parent to exit
-           sleep 2;
+           # kill 0 isn't portable:
+           my $can_kill0 = eval {
+               kill 0, $ppid1;
+           };
+           my $how = $can_kill0 ? 'undead' : 'sleep';
+
+           # Tell immediate parent to exit:
+           close $w2 or die "close: $!\n";
+           # Wait for it to (start to) exit:
+           <$r3>;
+           # Which sadly isn't enough to be sure that it has exited - often we
+           # get switched in during its shutdown, after $w3 closes but before
+           # it exits and we get reparented.
+           if ($can_kill0) {
+               # use kill 0 where possible. Try 10 times, then give up:
+               for (0..9) {
+                   my $got = kill 0, $ppid1;
+                   die "kill: $!" unless defined $got;
+                   if (!$got) {
+                       $how = 'kill';
+                       last;
+                   }
+                   sleep 1;
+               }
+           } else {
+               # Fudge it by waiting a bit more:
+               sleep 2;
+           }
            my $ppid2 = getppid();
-           print $w "$ppid1,$ppid2\n";
+           print $w "$how,$ppid1,$ppid2\n";
        }
        exit 0;
     }
@@ -68,5 +108,8 @@ sub fork_and_retrieve {
 
 my $first = fork_and_retrieve("first");
 my $second = fork_and_retrieve("second");
-is ($first, $second, "Both orphaned grandchildren get the same new parent");
+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");