Skip to content

Commit bd91c49

Browse files
committed
add direct tests for the bug reported in #22487
This was fixed by 85e9706 but the test only checked the sanity of the saved main thread thread id. Tested locally for failure by disarming the change in Perl_csighandler3.
1 parent b7929ab commit bd91c49

File tree

4 files changed

+74
-3
lines changed

4 files changed

+74
-3
lines changed

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.43';
7+
our $VERSION = '1.44';
88

99
require XSLoader;
1010

ext/XS-APItest/APItest.xs

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1601,6 +1601,17 @@ destruct_test(pTHX_ void *p) {
16011601
warn("In destruct_test: %" SVf "\n", (SV*)p);
16021602
}
16031603

1604+
#if defined(USE_ITHREADS) && !defined(WIN32)
1605+
1606+
static void *
1607+
signal_thread_start(void *arg) {
1608+
PERL_UNUSED_ARG(arg);
1609+
raise(SIGUSR1);
1610+
return NULL;
1611+
}
1612+
1613+
#endif
1614+
16041615
#ifdef PERL_USE_HWM
16051616
# define hwm_checks_enabled() true
16061617
#else
@@ -4367,6 +4378,21 @@ CODE:
43674378
OUTPUT:
43684379
RETVAL
43694380

4381+
pthread_t
4382+
make_signal_thread()
4383+
CODE:
4384+
if (pthread_create(&RETVAL, NULL, signal_thread_start, NULL) != 0)
4385+
XSRETURN_EMPTY;
4386+
OUTPUT:
4387+
RETVAL
4388+
4389+
int
4390+
join_signal_thread(pthread_t tid)
4391+
CODE:
4392+
RETVAL = pthread_join(tid, NULL);
4393+
OUTPUT:
4394+
RETVAL
4395+
43704396
# endif /* ifndef WIN32 */
43714397

43724398
#endif /* USE_ITHREADS */

ext/XS-APItest/t/thread.t

Lines changed: 32 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,15 +2,15 @@
22
use warnings;
33
use strict;
44
use Test2::IPC;
5-
use Test2::Tools::Basic;
5+
use Test2::V0;
66
use Config;
77

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

13-
use XS::APItest qw(thread_id_matches);
13+
use XS::APItest qw(thread_id_matches make_signal_thread join_signal_thread);
1414

1515
ok(thread_id_matches(),
1616
"check main thread id saved and is current thread");
@@ -38,4 +38,34 @@ SKIP:
3838
}
3939
}
4040

41+
{
42+
my $saw_signal;
43+
local $SIG{USR1} = sub { ++$saw_signal };
44+
my $pid = make_signal_thread();
45+
join_signal_thread($pid);
46+
ok($saw_signal, "saw signal sent to non-perl thread");
47+
}
48+
49+
{
50+
$Config{d_fork}
51+
or skip "Need fork", 1;
52+
my $pid = fork;
53+
defined $pid
54+
or skip "Fork failed", 1;
55+
if ($pid == 0) {
56+
# ensure the main thread saved is valid after fork
57+
my $saw_signal;
58+
local $SIG{USR1} = sub { ++$saw_signal };
59+
my $pid = make_signal_thread();
60+
join_signal_thread($pid);
61+
ok($saw_signal, "saw signal sent to non-perl thread in child");
62+
exit 0;
63+
}
64+
else {
65+
is(waitpid($pid, 0), $pid, "wait child");
66+
# catches the child segfaulting for example
67+
is($?, 0, "child success");
68+
}
69+
}
70+
4171
done_testing();

ext/XS-APItest/typemap

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,12 +3,27 @@ XS::APItest::PtrTable T_PTROBJ
33
const WCHAR * WPV
44
U8 * T_PV
55

6+
pthread_t T_THREADID
7+
68
INPUT
79

810
WPV
911
$var = ($type)SvPV_nolen($arg);
1012

13+
T_THREADID
14+
{
15+
STRLEN len;
16+
const char *pv = SvPVbyte($arg, len);
17+
if (len != sizeof(pthread_t))
18+
croak(\"Bad thread id for $arg\");
19+
Copy(pv, &$var, 1, pthread_t);
20+
}
21+
1122
OUTPUT
1223

1324
WPV
1425
sv_setpvn($arg, (const char *)($var), sizeof(WCHAR) * (1+wcslen($var)));
26+
27+
T_THREADID
28+
sv_setpvn($arg, (const char *)&($var), sizeof($var));
29+
SvUTF8_off($arg);

0 commit comments

Comments
 (0)