posixify getppid on linux-multithread

Message-Id: <20020806215646.3f6852bb.rgarciasuarez@free.fr>

p4raw-id: //depot/perl@17798

diff --git a/MANIFEST b/MANIFEST
index da2347b..99539c6 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2510,6 +2510,7 @@ t/op/fh.t                 See if filehandles work
 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/glob.t                    See if <*> works
 t/op/gmagic.t                  See if GMAGIC works
 t/op/goto.t                    See if goto works

diff --git a/embedvar.h b/embedvar.h
index 95e70b9..d6a30fb 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -1375,6 +1375,7 @@
 #define PL_malloc_mutex                (PL_Vars.Gmalloc_mutex)
 #define PL_op_mutex            (PL_Vars.Gop_mutex)
 #define PL_patleave            (PL_Vars.Gpatleave)
+#define PL_ppid                        (PL_Vars.Gppid)
 #define PL_runops_dbg          (PL_Vars.Grunops_dbg)
 #define PL_runops_std          (PL_Vars.Grunops_std)
 #define PL_sharehook           (PL_Vars.Gsharehook)
@@ -1393,6 +1394,7 @@
 #define PL_Gmalloc_mutex       PL_malloc_mutex
 #define PL_Gop_mutex           PL_op_mutex
 #define PL_Gpatleave           PL_patleave
+#define PL_Gppid               PL_ppid
 #define PL_Grunops_dbg         PL_runops_dbg
 #define PL_Grunops_std         PL_runops_std
 #define PL_Gsharehook          PL_sharehook

diff --git a/hints/linux.sh b/hints/linux.sh
index 7dccc1c..e152a6a 100644 (file)
--- a/hints/linux.sh
+++ b/hints/linux.sh
@@ -249,7 +249,7 @@ esac
 cat > UU/usethreads.cbu <<'EOCBU'
 case "$usethreads" in
 $define|true|[yY]*)
-        ccflags="-D_REENTRANT -D_GNU_SOURCE $ccflags"
+        ccflags="-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS $ccflags"
         set `echo X "$libswanted "| sed -e 's/ c / pthread c /'`
         shift
         libswanted="$*"

diff --git a/perl.c b/perl.c
index 58e2ac1..5aae0c8 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -3651,6 +3651,9 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
        sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
         SvREADONLY_on(GvSV(tmpgv));
     }
+#ifdef THREADS_HAVE_PIDS
+    PL_ppid = (IV)getppid();
+#endif
 
     /* touch @F array to prevent spurious warnings 20020415 MJD */
     if (PL_minus_a) {

diff --git a/perlapi.h b/perlapi.h
index 693689f..0e0fef2 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -966,6 +966,8 @@ END_EXTERN_C
 #define PL_op_mutex            (*Perl_Gop_mutex_ptr(NULL))
 #undef  PL_patleave
 #define PL_patleave            (*Perl_Gpatleave_ptr(NULL))
+#undef  PL_ppid
+#define PL_ppid                        (*Perl_Gppid_ptr(NULL))
 #undef  PL_runops_dbg
 #define PL_runops_dbg          (*Perl_Grunops_dbg_ptr(NULL))
 #undef  PL_runops_std

diff --git a/perlvars.h b/perlvars.h
index b841719..6b26f0e 100644 (file)
--- a/perlvars.h
+++ b/perlvars.h
@@ -58,3 +58,7 @@ PERLVARI(Glockhook,   share_proc_t,   MEMBER_TO_FPTR(Perl_sv_nolocking))
 PERLVARI(Gunlockhook,  share_proc_t,   MEMBER_TO_FPTR(Perl_sv_nounlocking))
 PERLVARI(Gthreadhook,  thrhook_proc_t, MEMBER_TO_FPTR(Perl_nothreadhook))
 
+/* Stores the PPID */
+#ifdef THREADS_HAVE_PIDS
+PERLVARI(Gppid,                IV,             0)
+#endif

diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 90eeb97..a489e71 100644 (file)
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -1870,6 +1870,13 @@ does not accept a PID argument, so only C<PID==0> is truly portable.
 
 Returns the process id of the parent process.
 
+Note for Linux users: on Linux, the C functions C<getpid()> and
+C<getppid()> return different values from different threads. In order to
+be portable, this behavior is not reflected by the perl-level function
+C<getppid()>, that returns a consistent value across threads. If you want
+to call the underlying C<getppid()>, consider using C<Inline::C> or
+another way to call a C library function.
+
 =item getpriority WHICH,WHO
 
 Returns the current priority for a process, a process group, or a user.

diff --git a/pod/perlvar.pod b/pod/perlvar.pod
index 7c0f596..d90df14 100644 (file)
--- a/pod/perlvar.pod
+++ b/pod/perlvar.pod
@@ -769,6 +769,12 @@ The process number of the Perl running this script.  You should
 consider this variable read-only, although it will be altered
 across fork() calls.  (Mnemonic: same as shells.)
 
+Note for Linux users: on Linux, the C functions C<getpid()> and
+C<getppid()> return different values from different threads. In order to
+be portable, this behavior is not reflected by C<$$>, whose value remains
+consistent across threads. If you want to call the underlying C<getpid()>,
+consider using C<Inline::C> or another way to call a C library function.
+
 =item $REAL_USER_ID
 
 =item $UID

diff --git a/pp_sys.c b/pp_sys.c
index 7a44b6b..54699c8 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3960,6 +3960,9 @@ PP(pp_fork)
            sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
             SvREADONLY_on(GvSV(tmpgv));
         }
+#ifdef THREADS_HAVE_PIDS
+       PL_ppid = (IV)getppid();
+#endif
        hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */
     }
     PUSHi(childpid);
@@ -4239,7 +4242,11 @@ PP(pp_getppid)
 {
 #ifdef HAS_GETPPID
     dSP; dTARGET;
+#   ifdef THREADS_HAVE_PIDS
+    XPUSHi( PL_ppid );
+#   else
     XPUSHi( getppid() );
+#   endif
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getppid");

diff --git a/t/op/getpid.t b/t/op/getpid.t
new file mode 100644 (file)
index 0000000..dd06f00
--- /dev/null
+++ b/t/op/getpid.t
@@ -0,0 +1,35 @@
+#!perl -w
+
+# Tests if $$ and getppid return consistent values across threads
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = qw(../lib);
+}
+
+use strict;
+use Config;
+
+BEGIN {
+    if (!$Config{useithreads}) {
+       print "1..0 # Skip: no ithreads\n";
+       exit;
+    }
+    if (!$Config{d_getppid}) {
+       print "1..0 # Skip: no getppid\n";
+       exit;
+    }
+}
+
+use threads;
+use threads::shared;
+
+my ($pid, $ppid) = ($$, getppid());
+my $pid2 : shared = 0;
+my $ppid2 : shared = 0;
+
+new threads( sub { ($pid2, $ppid2) = ($$, getppid()); } ) -> join();
+
+print "1..2\n";
+print "not " if $pid  != $pid2;  print "ok 1 - pids\n";
+print "not " if $ppid != $ppid2; print "ok 2 - ppids\n";

diff --git a/util.c b/util.c
index f275fca..35fb8a8 100644 (file)
--- a/util.c
+++ b/util.c
@@ -2155,10 +2155,13 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
 #endif /* defined OS2 */
        /*SUPPRESS 560*/
        if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV))) {
-        SvREADONLY_off(GvSV(tmpgv));
+           SvREADONLY_off(GvSV(tmpgv));
            sv_setiv(GvSV(tmpgv), PerlProc_getpid());
-        SvREADONLY_on(GvSV(tmpgv));
-    }
+           SvREADONLY_on(GvSV(tmpgv));
+       }
+#ifdef THREADS_HAVE_PIDS
+       PL_ppid = (IV)getppid();
+#endif
        PL_forkprocess = 0;
        hv_clear(PL_pidstatus); /* we have no children */
        return Nullfp;