From: Rafael Garcia-Suarez Date: Tue, 6 Aug 2002 21:56:46 +0000 (+0200) Subject: posixify getppid on linux-multithread X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4d76a3443f3312704ec3416fd425698e92a208cd;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -1870,6 +1870,13 @@ does not accept a PID argument, so only C is truly portable. Returns the process id of the parent process. +Note for Linux users: on Linux, the C functions C and +C return different values from different threads. In order to +be portable, this behavior is not reflected by the perl-level function +C, that returns a consistent value across threads. If you want +to call the underlying C, consider using 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 --- 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 and +C 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, +consider using 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 --- 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 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 --- 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;