1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
use warnings;
use strict;
BEGIN {
eval { require threads; };
if($@ =~ /\AThis Perl not built to support threads/) {
require Test::More;
Test::More::plan(skip_all => "non-threading perl build");
}
if($@ ne "") {
require Test::More;
Test::More::plan(skip_all => "threads unavailable");
}
if("$]" < 5.008003) {
require Test::More;
Test::More::plan(skip_all =>
"threading breaks PL_sv_placeholder on this Perl");
}
if("$]" < 5.008009) {
require Test::More;
Test::More::plan(skip_all =>
"threading corrupts memory on this Perl");
}
if("$]" >= 5.009005 && "$]" < 5.010001) {
require Test::More;
Test::More::plan(skip_all =>
"threading breaks assertions on this Perl");
}
eval { require Thread::Semaphore; };
if($@ ne "") {
require Test::More;
Test::More::plan(skip_all => "Thread::Semaphore unavailable");
}
eval { require threads::shared; };
if($@ ne "") {
require Test::More;
Test::More::plan(skip_all => "threads::shared unavailable");
}
}
use threads;
use Test::More tests => 3;
use Thread::Semaphore ();
use threads::shared;
alarm 10; # failure mode may involve an infinite loop
my(@exit_sems, @threads);
sub test_in_thread($) {
my($test_code) = @_;
my $done_sem = Thread::Semaphore->new(0);
my $exit_sem = Thread::Semaphore->new(0);
push @exit_sems, $exit_sem;
my $ok :shared;
push @threads, threads->create(sub {
$ok = !!$test_code->();
$done_sem->up;
$exit_sem->down;
});
$done_sem->down;
ok $ok;
}
BEGIN { unshift @INC, "./t/lib"; }
sub tsub1 (@) { $_[0] }
sub tsub2 (@) { $_[0] }
sub nsub (@) { $_[0] }
our @three = (3);
test_in_thread(sub {
require Devel::CallChecker;
require t::LoadXS;
require t::WriteHeader;
t::WriteHeader::write_header("callchecker0", "t", "threads1");
t::LoadXS::load_xs("threads1", "t",
[Devel::CallChecker::callchecker_linkable()]);
eval(q{nsub(@three)}) == 3 or return 0;
eval(q{tsub1(@three)}) == 3 or return 0;
t::threads1::cv_set_call_checker_proto(\&tsub1, "\$");
eval(q{nsub(@three)}) == 3 or return 0;
eval(q{tsub1(@three)}) == 1 or return 0;
return 1;
});
test_in_thread(sub {
require Devel::CallChecker;
require t::LoadXS;
require t::WriteHeader;
t::WriteHeader::write_header("callchecker0", "t", "threads2");
t::LoadXS::load_xs("threads2", "t",
[Devel::CallChecker::callchecker_linkable()]);
eval(q{nsub(@three)}) == 3 or return 0;
eval(q{tsub2(@three)}) == 3 or return 0;
t::threads2::cv_set_call_checker_proto(\&tsub2, "\$");
eval(q{nsub(@three)}) == 3 or return 0;
eval(q{tsub2(@three)}) == 1 or return 0;
return 1;
});
$_->up foreach @exit_sems;
$_->join foreach @threads;
ok 1;
1;
|
