Change 17798 by [EMAIL PROTECTED] on 2002/08/29 11:44:00
Subject: [PATCH] posixify getppid on linux-multithread
From: Rafael Garcia-Suarez <[EMAIL PROTECTED]>
Date: Tue, 6 Aug 2002 21:56:46 +0200
Message-Id: <[EMAIL PROTECTED]>
Affected files ...
.... //depot/perl/MANIFEST#935 edit
.... //depot/perl/embedvar.h#148 edit
.... //depot/perl/hints/linux.sh#44 edit
.... //depot/perl/perl.c#447 edit
.... //depot/perl/perlapi.h#70 edit
.... //depot/perl/perlvars.h#44 edit
.... //depot/perl/pod/perlfunc.pod#356 edit
.... //depot/perl/pod/perlvar.pod#107 edit
.... //depot/perl/pp_sys.c#317 edit
.... //depot/perl/t/op/getpid.t#1 add
.... //depot/perl/util.c#359 edit
Differences ...
==== //depot/perl/MANIFEST#935 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#934~17791~ Tue Aug 27 04:28:32 2002
+++ perl/MANIFEST Thu Aug 29 04:44:00 2002
@@ -2510,6 +2510,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/glob.t See if <*> works
t/op/gmagic.t See if GMAGIC works
t/op/goto.t See if goto works
==== //depot/perl/embedvar.h#148 (text+w) ====
Index: perl/embedvar.h
--- perl/embedvar.h#147~16963~ Sat Jun 1 09:15:24 2002
+++ perl/embedvar.h Thu Aug 29 04:44:00 2002
@@ -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
==== //depot/perl/hints/linux.sh#44 (text) ====
Index: perl/hints/linux.sh
--- perl/hints/linux.sh#43~17006~ Wed Jun 5 05:44:45 2002
+++ perl/hints/linux.sh Thu Aug 29 04:44:00 2002
@@ -249,7 +249,7 @@
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="$*"
==== //depot/perl/perl.c#447 (text) ====
Index: perl/perl.c
--- perl/perl.c#446~17740~ Tue Aug 20 07:07:56 2002
+++ perl/perl.c Thu Aug 29 04:44:00 2002
@@ -3651,6 +3651,9 @@
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) {
==== //depot/perl/perlapi.h#70 (text+w) ====
Index: perl/perlapi.h
--- perl/perlapi.h#69~16963~ Sat Jun 1 09:15:24 2002
+++ perl/perlapi.h Thu Aug 29 04:44:00 2002
@@ -966,6 +966,8 @@
#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
==== //depot/perl/perlvars.h#44 (text) ====
Index: perl/perlvars.h
--- perl/perlvars.h#43~15699~ Wed Apr 3 05:35:58 2002
+++ perl/perlvars.h Thu Aug 29 04:44:00 2002
@@ -58,3 +58,7 @@
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
==== //depot/perl/pod/perlfunc.pod#356 (text) ====
Index: perl/pod/perlfunc.pod
--- perl/pod/perlfunc.pod#355~17744~ Tue Aug 20 08:34:36 2002
+++ perl/pod/perlfunc.pod Thu Aug 29 04:44:00 2002
@@ -1870,6 +1870,13 @@
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.
==== //depot/perl/pod/perlvar.pod#107 (text) ====
Index: perl/pod/perlvar.pod
--- perl/pod/perlvar.pod#106~17789~ Mon Aug 26 21:04:48 2002
+++ perl/pod/perlvar.pod Thu Aug 29 04:44:00 2002
@@ -769,6 +769,12 @@
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
==== //depot/perl/pp_sys.c#317 (text) ====
Index: perl/pp_sys.c
--- perl/pp_sys.c#316~17676~ Sun Aug 4 08:14:09 2002
+++ perl/pp_sys.c Thu Aug 29 04:44:00 2002
@@ -3960,6 +3960,9 @@
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 @@
{
#ifdef HAS_GETPPID
dSP; dTARGET;
+# ifdef THREADS_HAVE_PIDS
+ XPUSHi( PL_ppid );
+# else
XPUSHi( getppid() );
+# endif
RETURN;
#else
DIE(aTHX_ PL_no_func, "getppid");
==== //depot/perl/t/op/getpid.t#1 (text) ====
Index: perl/t/op/getpid.t
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/t/op/getpid.t Thu Aug 29 04:44:00 2002
@@ -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";
==== //depot/perl/util.c#359 (text) ====
Index: perl/util.c
--- perl/util.c#358~17762~ Fri Aug 23 04:02:35 2002
+++ perl/util.c Thu Aug 29 04:44:00 2002
@@ -2155,10 +2155,13 @@
#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;
End of Patch.
