Change 25395 by [EMAIL PROTECTED] on 2005/09/12 21:50:04
Integrate:
[ 24367]
For perls where pids and ppids are cached, when the ppid of
the perl process becomes 1, refresh the ppid cache (this may
indicate that the parent process has died.)
[ 24703]
Simplify the getppid code, by Alexey Tourbin
[ 24709]
New test for getppid(), by Alexey Tourbin
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#238 integrate
... //depot/maint-5.8/perl/pp_sys.c#56 integrate
... //depot/maint-5.8/perl/t/op/getppid.t#1 branch
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#238 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#237~25378~ Sat Sep 10 13:11:32 2005
+++ perl/MANIFEST Mon Sep 12 14:50:04 2005
@@ -2675,6 +2675,7 @@
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
==== //depot/maint-5.8/perl/pp_sys.c#56 (text) ====
Index: perl/pp_sys.c
--- perl/pp_sys.c#55~25385~ Sun Sep 11 13:36:26 2005
+++ perl/pp_sys.c Mon Sep 12 14:50:04 2005
@@ -4298,6 +4298,9 @@
#ifdef HAS_GETPPID
dSP; dTARGET;
# ifdef THREADS_HAVE_PIDS
+ if (PL_ppid != 1 && getppid() == 1)
+ /* maybe the parent process has died. Refresh ppid cache */
+ PL_ppid = 1;
XPUSHi( PL_ppid );
# else
XPUSHi( getppid() );
==== //depot/maint-5.8/perl/t/op/getppid.t#1 (text) ====
Index: perl/t/op/getppid.t
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/t/op/getppid.t Mon Sep 12 14:50:04 2005
@@ -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;
+}
End of Patch.
