Skip to content

Commit 85e9706

Browse files
committed
csighandler3: forward signals to the main thread if not a perl thread
This is only done for pthreads, Win32 already uses something like my suggestion from #22530 and unlike POSIX doesn't have a way to asynchronously interrupt a thread that I'm aware of. It's also complicated by pseudo-processes. Fixes #22487
1 parent ed39ffd commit 85e9706

File tree

10 files changed

+67
-1
lines changed

10 files changed

+67
-1
lines changed

MANIFEST

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5190,6 +5190,7 @@ ext/XS-APItest/t/swaptwostmts.t test recursive descent statement parsing
51905190
ext/XS-APItest/t/sym-hook.t Test rv2cv hooks for bareword lookup
51915191
ext/XS-APItest/t/synthetic_scope.t Test block_start/block_end/intro_my
51925192
ext/XS-APItest/t/temp_lv_sub.t XS::APItest: tests for lvalue subs returning temps
5193+
ext/XS-APItest/t/thread.t Threads related tests
51935194
ext/XS-APItest/t/underscore_length.t Test find_rundefsv()
51945195
ext/XS-APItest/t/utf16_to_utf8.t Test behaviour of utf16_to_utf8{,reversed}
51955196
ext/XS-APItest/t/utf8.t Tests for code in utf8.c

ext/XS-APItest/APItest.pm

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ use strict;
44
use warnings;
55
use Carp;
66

7-
our $VERSION = '1.38';
7+
our $VERSION = '1.39';
88

99
require XSLoader;
1010

ext/XS-APItest/APItest.xs

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4298,6 +4298,18 @@ CODE:
42984298
exit(0);
42994299
}
43004300

4301+
# ifndef WIN32
4302+
4303+
bool
4304+
thread_id_matches()
4305+
CODE:
4306+
/* pthread_t might not be a scalar type */
4307+
RETVAL = pthread_equal(pthread_self(), PL_main_thread);
4308+
OUTPUT:
4309+
RETVAL
4310+
4311+
# endif /* ifndef WIN32 */
4312+
43014313
#endif /* USE_ITHREADS */
43024314

43034315
SV*

ext/XS-APItest/t/thread.t

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
#!perl
2+
use warnings;
3+
use strict;
4+
use Test2::Tools::Basic;
5+
use Config;
6+
7+
BEGIN {
8+
skip_all "Not pthreads or is win32"
9+
if !$Config{usethreads} || $^O eq "MSWin32";
10+
}
11+
12+
use XS::APItest qw(thread_id_matches);
13+
14+
ok(thread_id_matches(),
15+
"check main thread id saved and is current thread");
16+
17+
done_testing();

makedef.pl

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -461,6 +461,10 @@ sub readvar {
461461
++$skip{Perl_thread_locale_term};
462462
}
463463

464+
if (!$define{USE_ITHREADS} || $define{WIN32}) {
465+
++$skip{PL_main_thread};
466+
}
467+
464468
unless ($define{USE_POSIX_2008_LOCALE})
465469
{
466470
++$skip{$_} foreach qw(

mg.c

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1564,6 +1564,17 @@ Perl_csighandler3(int sig, Siginfo_t *sip PERL_UNUSED_DECL, void *uap PERL_UNUSE
15641564
dTHX;
15651565
#endif
15661566

1567+
#if defined(USE_ITHREADS) && !defined(WIN32)
1568+
if (!aTHX) {
1569+
/* presumably ths signal is being delivered to a non-perl
1570+
* thread, presumably created by a library, redirect it to the
1571+
* main thread.
1572+
*/
1573+
pthread_kill(PL_main_thread, sig);
1574+
return;
1575+
}
1576+
#endif
1577+
15671578
#ifdef PERL_USE_3ARG_SIGHANDLER
15681579
#if defined(__cplusplus) && defined(__GNUC__)
15691580
/* g++ doesn't support PERL_UNUSED_DECL, so the sip and uap

perl.c

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -90,6 +90,7 @@ S_init_tls_and_interp(PerlInterpreter *my_perl)
9090
ENV_INIT;
9191
MUTEX_INIT(&PL_dollarzero_mutex);
9292
MUTEX_INIT(&PL_my_ctx_mutex);
93+
PTHREAD_INIT_SELF(PL_main_thread);
9394
# endif
9495
}
9596
#if defined(USE_ITHREADS)

perlvars.h

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,20 @@ PERLVARI(G, curinterp, PerlInterpreter *, NULL)
4343
* useithreads) */
4444
#if defined(USE_ITHREADS)
4545
PERLVAR(G, thr_key, perl_key) /* key to retrieve per-thread struct */
46+
47+
# ifndef WIN32
48+
/* Used to re-send signals we receive on a non-perl thread to the main
49+
* thread. Windows uses window messages to do this so we don't need
50+
* it there.
51+
*
52+
* If we do end up adding this for Windows it will need more complex
53+
* management since we'd want to store a thread handle (a HANDLE)
54+
* which needs clean up on exit.
55+
*/
56+
57+
PERLVAR(G, main_thread, pthread_t)
58+
# endif
59+
4660
#endif
4761

4862
/* XXX does anyone even use this? */

thread.h

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -82,6 +82,10 @@
8282
# endif
8383
#endif
8484

85+
#ifndef PTHREAD_INIT_SELF
86+
# define PTHREAD_INIT_SELF(var) (var = pthread_self())
87+
#endif
88+
8589
#ifdef __VMS
8690
/* Default is 1024 on VAX, 8192 otherwise */
8791
# ifdef __ia64

win32/win32thread.h

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -161,6 +161,8 @@ END_EXTERN_C
161161

162162
#define PTHREAD_ATFORK(prepare,parent,child) NOOP
163163

164+
#define PTHREAD_INIT_SELF(var) NOOP
165+
164166
#if defined(USE_RTL_THREAD_API) && !defined(_MSC_VER)
165167
#define JOIN(t, avp) \
166168
STMT_START { \

0 commit comments

Comments
 (0)