6 BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
8 my ($module, $thread_safe_var);
11 $thread_safe_var = 'indirect::I_THREADSAFE()';
16 if (defined &indirect::msg) {
18 eval 'BEGIN { indirect->unimport(":fatal") if defined &indirect::msg } return; my $x = new X;';
21 if (defined $res and $res =~ /^Indirect call of method/) {
23 } elsif (not defined $res or $res eq '') {
30 # Keep the rest of the file untouched
33 use VPIT::TestHelpers threads => [ $module, $thread_safe_var ];
35 my $could_not_create_thread = 'Could not create thread';
37 use Test::Leaner tests => 1 + (2 + 2 * 2) + 6 + (2 * 4 + 1) * 2 + 1;
40 my ($affirmative, $desc) = @_;
42 my $res = load_test();
47 $desc = "$desc: module loaded";
50 $desc = "$desc: module not loaded";
53 unless (is $res, $expected, $desc) {
54 $res = defined $res ? "'$res'" : 'undef';
55 $expected = "'$expected'";
56 diag("Test '$desc' failed: got $res, expected $expected");
64 my $code = eval "sub { require $module }";
69 is_loaded 0, 'main body, beginning';
71 # Test serial loadings
75 my $here = "first serial thread";
76 is_loaded 0, "$here, beginning";
79 is_loaded 1, "$here, after loading";
84 skip "$could_not_create_thread (serial 1)" => 2 unless defined $thr;
87 if (my $err = $thr->error) {
92 is_loaded 0, 'main body, in between serial loadings';
96 my $here = "second serial thread";
97 is_loaded 0, "$here, beginning";
100 is_loaded 1, "$here, after loading";
105 skip "$could_not_create_thread (serial 2)" => 2 unless defined $thr;
108 if (my $err = $thr->error) {
113 is_loaded 0, 'main body, after serial loadings';
115 # Test nested loadings
118 my $thr = spawn(sub {
119 my $here = 'parent thread';
120 is_loaded 0, "$here, beginning";
123 my $kid = spawn(sub {
124 my $here = 'child thread';
125 is_loaded 0, "$here, beginning";
128 is_loaded 1, "$here, after loading";
133 skip "$could_not_create_thread (nested child)" => 2 unless defined $kid;
136 if (my $err = $kid->error) {
137 die "in child thread: $err\n";
141 is_loaded 0, "$here, after child terminated";
144 is_loaded 1, "$here, after loading";
149 skip "$could_not_create_thread (nested parent)" => (3 + 2) unless defined $thr;
152 if (my $err = $thr->error) {
157 is_loaded 0, 'main body, after nested loadings';
159 # Test parallel loadings
166 my @locks_down = (1) x $sync_points;
167 my @locks_up = (0) x $sync_points;
168 share($_) for @locks_down, @locks_up;
170 my $default_peers = 2;
173 my ($id, $peers) = @_;
175 $peers = $default_peers unless defined $peers;
178 lock $locks_down[$id];
179 $locks_down[$id] = 0;
180 cond_broadcast $locks_down[$id];
185 cond_wait $locks_up[$id] until $locks_up[$id] == $peers;
193 lock $locks_down[$id];
194 cond_wait $locks_down[$id] until $locks_down[$id] == 0;
200 cond_signal $locks_up[$id];
204 for my $first_thread_ends_first (0, 1) {
205 for my $id (0 .. $sync_points - 1) {
207 lock $locks_down[$id];
208 $locks_down[$id] = 1;
216 my $thr1_end = 'finishes first';
217 my $thr2_end = 'finishes last';
219 ($thr1_end, $thr2_end) = ($thr2_end, $thr1_end)
220 unless $first_thread_ends_first;
223 my $thr1 = spawn(sub {
224 my $here = "first simultaneous thread ($thr1_end)";
227 is_loaded 0, "$here, beginning";
231 is_loaded 1, "$here, after loading";
236 is_loaded 1, "$here, still loaded while also loaded in the other thread";
239 sync_slave 6 unless $first_thread_ends_first;
241 is_loaded 1, "$here, end";
246 skip "$could_not_create_thread (parallel 1)" => (4 * 2) unless defined $thr1;
248 my $thr2 = spawn(sub {
249 my $here = "second simultaneous thread ($thr2_end)";
252 is_loaded 0, "$here, beginning";
257 is_loaded 0, "$here, loaded in other thread but not here";
260 is_loaded 1, "$here, after loading";
264 sync_slave 6 if $first_thread_ends_first;
266 is_loaded 1, "$here, end";
271 sync_master($_) for 0 .. 5;
274 ($thr2, $thr1) = ($thr1, $thr2) unless $first_thread_ends_first;
277 if (my $err = $thr1->error) {
284 if (my $err = $thr1->error) {
288 sync_master(6, 1) unless $first_thread_ends_first;
291 if (my $err = $thr1->error) {
295 skip "$could_not_create_thread (parallel 2)" => (4 * 1);
299 is_loaded 0, 'main body, after simultaneous threads';
303 is_loaded 1, 'main body, loaded at end';