6 my ($module, $thread_safe_var);
8 $module = 'autovivification';
9 $thread_safe_var = 'autovivification::A_THREADSAFE()';
14 if (defined &autovivification::unimport) {
16 eval 'BEGIN { autovivification->unimport } my $y = $x->[0]';
23 } elsif ( (not ref $x and not length $x)
24 or (ref $x eq 'ARRAY' and not @$x )) {
31 # Keep the rest of the file untouched
34 use VPIT::TestHelpers threads => [ $module, $thread_safe_var ];
36 my $could_not_create_thread = 'Could not create thread';
41 my ($affirmative, $desc) = @_;
43 my $res = load_test();
48 $desc = "$desc: module loaded";
51 $desc = "$desc: module not loaded";
54 unless (is $res, $expected, $desc) {
55 $res = defined $res ? "'$res'" : 'undef';
56 $expected = "'$expected'";
57 diag("Test '$desc' failed: got $res, expected $expected");
65 my $code = eval "sub { require $module }";
70 is_loaded 0, 'main body, beginning';
72 # Test serial loadings
76 my $here = "first serial thread";
77 is_loaded 0, "$here, beginning";
80 is_loaded 1, "$here, after loading";
85 skip "$could_not_create_thread (serial 1)" => 2 unless defined $thr;
88 if (my $err = $thr->error) {
93 is_loaded 0, 'main body, in between serial loadings';
97 my $here = "second serial thread";
98 is_loaded 0, "$here, beginning";
101 is_loaded 1, "$here, after loading";
106 skip "$could_not_create_thread (serial 2)" => 2 unless defined $thr;
109 if (my $err = $thr->error) {
114 is_loaded 0, 'main body, after serial loadings';
116 # Test nested loadings
119 my $parent = spawn(sub {
120 my $here = 'parent thread';
121 is_loaded 0, "$here, beginning";
124 my $kid = spawn(sub {
125 my $here = 'child thread';
126 is_loaded 0, "$here, beginning";
129 is_loaded 1, "$here, after loading";
134 skip "$could_not_create_thread (nested child)" => 2 unless defined $kid;
137 if (my $err = $kid->error) {
138 die "in child thread: $err\n";
142 is_loaded 0, "$here, after child terminated";
145 is_loaded 1, "$here, after loading";
150 skip "$could_not_create_thread (nested parent)" => (3 + 2)
151 unless defined $parent;
154 if (my $err = $parent->error) {
159 is_loaded 0, 'main body, after nested loadings';
161 # Test parallel loadings
168 my @locks_down = (1) x $sync_points;
169 my @locks_up = (0) x $sync_points;
170 share($_) for @locks_down, @locks_up;
172 my $default_peers = 2;
175 my ($id, $peers) = @_;
177 $peers = $default_peers unless defined $peers;
180 lock $locks_down[$id];
181 $locks_down[$id] = 0;
182 cond_broadcast $locks_down[$id];
187 my $timeout = time() + 10;
188 until ($locks_up[$id] == $peers) {
189 if (cond_timedwait $locks_up[$id], $timeout) {
204 lock $locks_down[$id];
205 cond_wait $locks_down[$id] until $locks_down[$id] == 0;
211 cond_signal $locks_up[$id];
217 for my $first_thread_ends_first (0, 1) {
218 for my $id (0 .. $sync_points - 1) {
220 lock $locks_down[$id];
221 $locks_down[$id] = 1;
229 my $thr1_end = 'finishes first';
230 my $thr2_end = 'finishes last';
232 ($thr1_end, $thr2_end) = ($thr2_end, $thr1_end)
233 unless $first_thread_ends_first;
236 my $thr1 = spawn(sub {
237 my $here = "first simultaneous thread ($thr1_end)";
240 is_loaded 0, "$here, beginning";
244 is_loaded 1, "$here, after loading";
249 is_loaded 1, "$here, still loaded while also loaded in the other thread";
252 sync_slave 6 unless $first_thread_ends_first;
254 is_loaded 1, "$here, end";
259 skip "$could_not_create_thread (parallel 1)" => (4 * 2) unless defined $thr1;
261 my $thr2 = spawn(sub {
262 my $here = "second simultaneous thread ($thr2_end)";
265 is_loaded 0, "$here, beginning";
270 is_loaded 0, "$here, loaded in other thread but not here";
273 is_loaded 1, "$here, after loading";
277 sync_slave 6 if $first_thread_ends_first;
279 is_loaded 1, "$here, end";
284 sync_master($_) for 0 .. 5;
287 ($thr2, $thr1) = ($thr1, $thr2) unless $first_thread_ends_first;
290 if (my $err = $thr1->error) {
297 if (my $err = $thr1->error) {
301 sync_master(6, 1) unless $first_thread_ends_first;
304 if (my $err = $thr1->error) {
308 skip "$could_not_create_thread (parallel 2)" => (4 * 1);
312 is_loaded 0, 'main body, after simultaneous threads';
318 my $parent = spawn(sub {
319 my $here = 'simple clone, parent thread';
320 is_loaded 0, "$here, beginning";
323 is_loaded 1, "$here, after loading";
326 my $kid = spawn(sub {
327 my $here = 'simple clone, child thread';
329 is_loaded 1, "$here, beginning";
334 skip "$could_not_create_thread (simple clone child)" => 1
338 if (my $err = $kid->error) {
339 die "in child thread: $err\n";
343 is_loaded 1, "$here, after child terminated";
348 skip "$could_not_create_thread (simple clone parent)" => (3 + 1)
349 unless defined $parent;
352 if (my $err = $parent->error) {
357 is_loaded 0, 'main body, after simple clone';
359 # Test clone outliving its parent
365 my $parent = spawn(sub {
366 my $here = 'outliving clone, parent thread';
367 is_loaded 0, "$here, beginning";
370 is_loaded 1, "$here, after loading";
375 my $kid = spawn(sub {
376 my $here = 'outliving clone, child thread';
378 is_loaded 1, "$here, beginning";
382 cond_wait $kid_done until $kid_done;
385 is_loaded 1, "$here, end";
391 $kid_tid = $kid->tid;
394 skip "$could_not_create_thread (outliving clone child)" => 2;
398 is_loaded 1, "$here, end";
403 skip "$could_not_create_thread (outliving clone parent)" => (3 + 2)
404 unless defined $parent;
406 my $kid_tid = $parent->join;
407 if (my $err = $parent->error) {
412 my $kid = threads->object($kid_tid);
414 if ($kid->is_running) {
417 cond_signal $kid_done;
425 is_loaded 0, 'main body, after outliving clone';
428 is_loaded 1, 'main body, loaded at end';