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

diff --git a/pp_sys.c b/pp_sys.c
index c127b64..ec094a0 100644 (file)
--- 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() );