mirror of
https://github.com/Perl/perl5.git
synced 2026-01-26 08:38:23 +00:00
update PL_main_thread on fork()
85e97066 modified the perl signal handler to forward signals to the main thread if it received a signal in a non-perl thread, which required saving the id of the main perl thread. Unfortunately I forgot to handle a possible change in the main thread id on a fork, this fixes that by re-saving the new main thread id immediately after a fork (via pthread_atfork()) On Linux it appears that the main thread id returned by pthread_seld() is constant between processes, but this may not be true on other platforms. Discussed at: https://github.com/Perl/perl5/issues/23326#issuecomment-3050481975
This commit is contained in:
parent
147364886f
commit
b68c393ee9
@ -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
|
||||
|
||||
1
embed.h
1
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)
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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();
|
||||
|
||||
@ -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;
|
||||
|
||||
4
proto.h
generated
4
proto.h
generated
@ -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
|
||||
|
||||
12
util.c
12
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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user