New test for getppid(), by Alexey Tourbin

p4raw-id: //depot/perl@24709

diff --git a/MANIFEST b/MANIFEST
index 9fb3834..2e5af00 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2780,6 +2780,7 @@ t/op/filetest.t                   See if file tests work
 t/op/flip.t                    See if range operator works
 t/op/fork.t                    See if fork works
 t/op/getpid.t                  See if $$ and getppid work with threads
+t/op/getppid.t                 See if getppid works
 t/op/glob.t                    See if <*> works
 t/op/gmagic.t                  See if GMAGIC works
 t/op/goto.t                    See if goto works

diff --git a/t/op/getppid.t b/t/op/getppid.t
new file mode 100644 (file)
index 0000000..cb48688
--- /dev/null
+++ b/t/op/getppid.t
@@ -0,0 +1,54 @@
+#!./perl
+
+# Test that getppid() follows UNIX semantics: when the parent process
+# dies, the child is reparented to the init process (pid 1).
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = qw(../lib);
+}
+
+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";
+}
+
+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) {
+       close $w;
+       sleep 1;
+    }
+    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";
+    }
+    exit 0;
+}