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.)

p4raw-id: //depot/perl@24367

1 files changed, 6 insertions, 0 deletions

diff --git a/pp_sys.c b/pp_sys.c
index c127b64fdb..ec094a001c 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4377,6 +4377,12 @@ PP(pp_getppid)
 #ifdef HAS_GETPPID
     dSP; dTARGET;
 #   ifdef THREADS_HAVE_PIDS
+    {
+	IV cur_ppid = getppid();
+	if (cur_ppid == 1)
+	    /* maybe the parent process has died. Refresh ppid cache */
+	    PL_ppid = cur_ppid;
+    }
     XPUSHi( PL_ppid );
 #   else
     XPUSHi( getppid() );