Skip to content

Commit

Permalink
csighandler3: forward signals to the main thread if not a perl thread
Browse files Browse the repository at this point in the history
This is only done for pthreads, Win32 already uses something like
my suggestion from Perl#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 Perl#22487
  • Loading branch information
tonycoz committed Nov 14, 2024
1 parent f9dabf1 commit f94d55d
Show file tree
Hide file tree
Showing 10 changed files with 67 additions and 1 deletion.
1 change: 1 addition & 0 deletions MANIFEST
Original file line number Diff line number Diff line change
Expand Up @@ -5190,6 +5190,7 @@ ext/XS-APItest/t/swaptwostmts.t test recursive descent statement parsing
ext/XS-APItest/t/sym-hook.t Test rv2cv hooks for bareword lookup
ext/XS-APItest/t/synthetic_scope.t Test block_start/block_end/intro_my
ext/XS-APItest/t/temp_lv_sub.t XS::APItest: tests for lvalue subs returning temps
ext/XS-APItest/t/thread.t Threads related tests
ext/XS-APItest/t/underscore_length.t Test find_rundefsv()
ext/XS-APItest/t/utf16_to_utf8.t Test behaviour of utf16_to_utf8{,reversed}
ext/XS-APItest/t/utf8.t Tests for code in utf8.c
Expand Down
2 changes: 1 addition & 1 deletion ext/XS-APItest/APItest.pm
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ use strict;
use warnings;
use Carp;

our $VERSION = '1.38';
our $VERSION = '1.39';

require XSLoader;

Expand Down
12 changes: 12 additions & 0 deletions ext/XS-APItest/APItest.xs
Original file line number Diff line number Diff line change
Expand Up @@ -4298,6 +4298,18 @@ CODE:
exit(0);
}

# ifndef WIN32

bool
thread_id_matches()
CODE:
/* pthread_t might not be a scalar type */
RETVAL = pthread_equal(pthread_self(), PL_main_thread);
OUTPUT:
RETVAL

# endif /* ifndef WIN32 */

#endif /* USE_ITHREADS */

SV*
Expand Down
17 changes: 17 additions & 0 deletions ext/XS-APItest/t/thread.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,17 @@
#!perl
use warnings;
use strict;
use Test2::Tools::Basic;
use Config;

BEGIN {
skip_all "Not pthreads or is win32"
if !$Config{usethreads} || $^O eq "MSWin32";
}

use XS::APItest qw(thread_id_matches);

ok(thread_id_matches(),
"check main thread id saved and is current thread");

done_testing();
4 changes: 4 additions & 0 deletions makedef.pl
Original file line number Diff line number Diff line change
Expand Up @@ -461,6 +461,10 @@ sub readvar {
++$skip{Perl_thread_locale_term};
}

if (!$define{USE_ITHREADS} || $define{WIN32}) {
++$skip{PL_main_thread};
}

unless ($define{USE_POSIX_2008_LOCALE})
{
++$skip{$_} foreach qw(
Expand Down
11 changes: 11 additions & 0 deletions mg.c
Original file line number Diff line number Diff line change
Expand Up @@ -1564,6 +1564,17 @@ Perl_csighandler3(int sig, Siginfo_t *sip PERL_UNUSED_DECL, void *uap PERL_UNUSE
dTHX;
#endif

#if defined(USE_ITHREADS) && !defined(WIN32)
if (!aTHX) {
/* presumably ths signal is being delivered to a non-perl
* thread, presumably created by a library, redirect it to the
* main thread.
*/
pthread_kill(PL_main_thread, sig);
return;
}
#endif

#ifdef PERL_USE_3ARG_SIGHANDLER
#if defined(__cplusplus) && defined(__GNUC__)
/* g++ doesn't support PERL_UNUSED_DECL, so the sip and uap
Expand Down
1 change: 1 addition & 0 deletions perl.c
Original file line number Diff line number Diff line change
Expand Up @@ -90,6 +90,7 @@ S_init_tls_and_interp(PerlInterpreter *my_perl)
ENV_INIT;
MUTEX_INIT(&PL_dollarzero_mutex);
MUTEX_INIT(&PL_my_ctx_mutex);
PTHREAD_INIT_SELF(PL_main_thread);
# endif
}
#if defined(USE_ITHREADS)
Expand Down
14 changes: 14 additions & 0 deletions perlvars.h
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,20 @@ PERLVARI(G, curinterp, PerlInterpreter *, NULL)
* useithreads) */
#if defined(USE_ITHREADS)
PERLVAR(G, thr_key, perl_key) /* key to retrieve per-thread struct */

# ifndef WIN32
/* Used to re-send signals we receive on a non-perl thread to the main
* thread. Windows uses window messages to do this so we don't need
* it there.
*
* If we do end up adding this for Windows it will need more complex
* management since we'd want to store a thread handle (a HANDLE)
* which needs clean up on exit.
*/

PERLVAR(G, main_thread, pthread_t)
# endif

#endif

/* XXX does anyone even use this? */
Expand Down
4 changes: 4 additions & 0 deletions thread.h
Original file line number Diff line number Diff line change
Expand Up @@ -82,6 +82,10 @@
# endif
#endif

#ifndef PTHREAD_INIT_SELF
# define PTHREAD_INIT_SELF(var) (var = pthread_self())
#endif

#ifdef __VMS
/* Default is 1024 on VAX, 8192 otherwise */
# ifdef __ia64
Expand Down
2 changes: 2 additions & 0 deletions win32/win32thread.h
Original file line number Diff line number Diff line change
Expand Up @@ -161,6 +161,8 @@ END_EXTERN_C

#define PTHREAD_ATFORK(prepare,parent,child) NOOP

#define PTHREAD_INIT_SELF(var) NOOP

#if defined(USE_RTL_THREAD_API) && !defined(_MSC_VER)
#define JOIN(t, avp) \
STMT_START { \
Expand Down

0 comments on commit f94d55d

Please sign in to comment.