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 cad0078..a8d0f2c 100644 (file)
--- a/t/op/getppid.t
+++ b/t/op/getppid.t
@@ -20,6 +20,9 @@ BEGIN {
     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";
@@ -31,9 +34,12 @@ sub fork_and_retrieve {
        $_ = <$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");
+       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';
@@ -48,18 +54,53 @@ sub fork_and_retrieve {
        $::NO_ENDING = 1;
        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 or die "close: $!\n";
-           sleep 1;
+           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;
     }