File tree Expand file tree Collapse file tree 4 files changed +74
-3
lines changed Expand file tree Collapse file tree 4 files changed +74
-3
lines changed Original file line number Diff line number Diff line change @@ -4,7 +4,7 @@ use strict;
4
4
use warnings;
5
5
use Carp;
6
6
7
- our $VERSION = ' 1.43 ' ;
7
+ our $VERSION = ' 1.44 ' ;
8
8
9
9
require XSLoader;
10
10
Original file line number Diff line number Diff line change @@ -1601,6 +1601,17 @@ destruct_test(pTHX_ void *p) {
1601
1601
warn ("In destruct_test: %" SVf "\n" , (SV * )p );
1602
1602
}
1603
1603
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
+
1604
1615
#ifdef PERL_USE_HWM
1605
1616
# define hwm_checks_enabled () true
1606
1617
#else
@@ -4367,6 +4378,21 @@ CODE:
4367
4378
OUTPUT :
4368
4379
RETVAL
4369
4380
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
+
4370
4396
# endif /* ifndef WIN32 */
4371
4397
4372
4398
#endif /* USE_ITHREADS */
Original file line number Diff line number Diff line change 2
2
use warnings;
3
3
use strict;
4
4
use Test2::IPC;
5
- use Test2::Tools::Basic ;
5
+ use Test2::V0 ;
6
6
use Config;
7
7
8
8
BEGIN {
9
9
skip_all " Not pthreads or is win32"
10
10
if !$Config {usethreads } || $^O eq " MSWin32" ;
11
11
}
12
12
13
- use XS::APItest qw( thread_id_matches) ;
13
+ use XS::APItest qw( thread_id_matches make_signal_thread join_signal_thread ) ;
14
14
15
15
ok(thread_id_matches(),
16
16
" check main thread id saved and is current thread" );
38
38
}
39
39
}
40
40
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
+
41
71
done_testing();
Original file line number Diff line number Diff line change @@ -3,12 +3,27 @@ XS::APItest::PtrTable T_PTROBJ
3
3
const WCHAR * WPV
4
4
U8 * T_PV
5
5
6
+ pthread_t T_THREADID
7
+
6
8
INPUT
7
9
8
10
WPV
9
11
$var = ($type)SvPV_nolen($arg);
10
12
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
+
11
22
OUTPUT
12
23
13
24
WPV
14
25
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);
You can’t perform that action at this time.
0 commit comments