diff --git a/embed.fnc b/embed.fnc index c2672a3672..a82ef1820f 100644 --- a/embed.fnc +++ b/embed.fnc @@ -711,6 +711,7 @@ Apx |void |apply_attrs_string \ Adp |OP * |apply_builtin_cv_attributes \ |NN CV *cv \ |NULLOK OP *attrlist +CTp |void |atfork_child CTp |void |atfork_lock CTp |void |atfork_unlock Cop |SV ** |av_arylen_p |NN AV *av diff --git a/embed.h b/embed.h index 0e43cdce21..42386005b3 100644 --- a/embed.h +++ b/embed.h @@ -131,6 +131,7 @@ # define amagic_deref_call(a,b) Perl_amagic_deref_call(aTHX_ a,b) # define apply_attrs_string(a,b,c,d) Perl_apply_attrs_string(aTHX_ a,b,c,d) # define apply_builtin_cv_attributes(a,b) Perl_apply_builtin_cv_attributes(aTHX_ a,b) +# define atfork_child Perl_atfork_child # define atfork_lock Perl_atfork_lock # define atfork_unlock Perl_atfork_unlock # define av_clear(a) Perl_av_clear(aTHX_ a) diff --git a/ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm b/ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm index d7d4b71411..c6117385bc 100644 --- a/ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm +++ b/ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm @@ -5,7 +5,7 @@ use Exporter 'import'; use ExtUtils::Embed 1.31, qw(xsi_header xsi_protos xsi_body); our @EXPORT = qw(writemain); -our $VERSION = '1.14'; +our $VERSION = '1.15'; # blead will run this with miniperl, hence we can't use autodie or File::Temp my $temp; @@ -122,7 +122,7 @@ main(int argc, char **argv, char **env) * --GSAR 2001-07-20 */ PTHREAD_ATFORK(Perl_atfork_lock, Perl_atfork_unlock, - Perl_atfork_unlock); + Perl_atfork_child); #endif PERL_SYS_FPU_INIT; diff --git a/ext/XS-APItest/t/thread.t b/ext/XS-APItest/t/thread.t index fe5ac953ba..00399a2427 100644 --- a/ext/XS-APItest/t/thread.t +++ b/ext/XS-APItest/t/thread.t @@ -1,6 +1,7 @@ #!perl use warnings; use strict; +use Test2::IPC; use Test2::Tools::Basic; use Config; @@ -14,4 +15,27 @@ use XS::APItest qw(thread_id_matches); ok(thread_id_matches(), "check main thread id saved and is current thread"); +# This test isn't too useful on Linux, it passes without the fix. +# +# thread ids are unique only within a process, so it's valid for Linux +# pthread_self() to return the same id for the main thread after a +# fork. +# +# This may be different on other POSIX-likes. +SKIP: +{ + $Config{d_fork} + or skip "Need fork", 1; + my $pid = fork; + defined $pid + or skip "Fork failed", 1; + if ($pid == 0) { + ok(thread_id_matches(), "check main thread id is updated by fork"); + exit; + } + else { + waitpid($pid, 0); + } +} + done_testing(); diff --git a/miniperlmain.c b/miniperlmain.c index 38951e0027..64ee56830f 100644 --- a/miniperlmain.c +++ b/miniperlmain.c @@ -96,7 +96,7 @@ main(int argc, char **argv, char **env) * --GSAR 2001-07-20 */ PTHREAD_ATFORK(Perl_atfork_lock, Perl_atfork_unlock, - Perl_atfork_unlock); + Perl_atfork_child); #endif PERL_SYS_FPU_INIT; diff --git a/proto.h b/proto.h index dae9c48a52..f64a9ff647 100644 --- a/proto.h +++ b/proto.h @@ -212,6 +212,10 @@ Perl_apply_builtin_cv_attributes(pTHX_ CV *cv, OP *attrlist); #define PERL_ARGS_ASSERT_APPLY_BUILTIN_CV_ATTRIBUTES \ assert(cv); assert(SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM) +PERL_CALLCONV void +Perl_atfork_child(void); +#define PERL_ARGS_ASSERT_ATFORK_CHILD + PERL_CALLCONV void Perl_atfork_lock(void); #define PERL_ARGS_ASSERT_ATFORK_LOCK diff --git a/util.c b/util.c index 2542cfbecd..914240e756 100644 --- a/util.c +++ b/util.c @@ -2872,6 +2872,18 @@ Perl_atfork_unlock(void) #endif } +void +Perl_atfork_child(void) { +#ifdef USE_ITHREADS + /* so we can resend signals received in a non-perl thread to the + new main thread + */ + PTHREAD_INIT_SELF(PL_main_thread); +#endif + + Perl_atfork_unlock(); +} + /* =for apidoc_section $concurrency =for apidoc my_fork