6 my ($module, $thread_safe_var);
8 $module = 'Variable::Magic';
9 $thread_safe_var = 'Variable::Magic::VMG_THREADSAFE()';
14 if (defined &Variable::Magic::wizard) {
15 my $wiz = Variable::Magic::wizard(
16 free => sub { $res = 1; return },
19 &Variable::Magic::cast(\$var, $wiz);
25 # Keep the rest of the file untouched
28 use VPIT::TestHelpers threads => [ $module, $thread_safe_var ];
30 my $could_not_create_thread = 'Could not create thread';
35 my ($affirmative, $desc) = @_;
37 my $res = load_test();
42 $desc = "$desc: module loaded";
45 $desc = "$desc: module not loaded";
48 unless (is $res, $expected, $desc) {
49 $res = defined $res ? "'$res'" : 'undef';
50 $expected = "'$expected'";
51 diag("Test '$desc' failed: got $res, expected $expected");
59 my $code = eval "sub { require $module }";
64 is_loaded 0, 'main body, beginning';
66 # Test serial loadings
70 my $here = "first serial thread";
71 is_loaded 0, "$here, beginning";
74 is_loaded 1, "$here, after loading";
79 skip "$could_not_create_thread (serial 1)" => 2 unless defined $thr;
82 if (my $err = $thr->error) {
87 is_loaded 0, 'main body, in between serial loadings';
91 my $here = "second serial thread";
92 is_loaded 0, "$here, beginning";
95 is_loaded 1, "$here, after loading";
100 skip "$could_not_create_thread (serial 2)" => 2 unless defined $thr;
103 if (my $err = $thr->error) {
108 is_loaded 0, 'main body, after serial loadings';
110 # Test nested loadings
113 my $parent = spawn(sub {
114 my $here = 'parent thread';
115 is_loaded 0, "$here, beginning";
118 my $kid = spawn(sub {
119 my $here = 'child thread';
120 is_loaded 0, "$here, beginning";
123 is_loaded 1, "$here, after loading";
128 skip "$could_not_create_thread (nested child)" => 2 unless defined $kid;
131 if (my $err = $kid->error) {
132 die "in child thread: $err\n";
136 is_loaded 0, "$here, after child terminated";
139 is_loaded 1, "$here, after loading";
144 skip "$could_not_create_thread (nested parent)" => (3 + 2)
145 unless defined $parent;
148 if (my $err = $parent->error) {
153 is_loaded 0, 'main body, after nested loadings';
155 # Test parallel loadings
162 my @locks_down = (1) x $sync_points;
163 my @locks_up = (0) x $sync_points;
164 share($_) for @locks_down, @locks_up;
166 my $default_peers = 2;
169 my ($id, $peers) = @_;
171 $peers = $default_peers unless defined $peers;
174 lock $locks_down[$id];
175 $locks_down[$id] = 0;
176 cond_broadcast $locks_down[$id];
181 my $timeout = time() + 10;
182 until ($locks_up[$id] == $peers) {
183 if (cond_timedwait $locks_up[$id], $timeout) {
198 lock $locks_down[$id];
199 cond_wait $locks_down[$id] until $locks_down[$id] == 0;
205 cond_signal $locks_up[$id];
211 for my $first_thread_ends_first (0, 1) {
212 for my $id (0 .. $sync_points - 1) {
214 lock $locks_down[$id];
215 $locks_down[$id] = 1;
223 my $thr1_end = 'finishes first';
224 my $thr2_end = 'finishes last';
226 ($thr1_end, $thr2_end) = ($thr2_end, $thr1_end)
227 unless $first_thread_ends_first;
230 my $thr1 = spawn(sub {
231 my $here = "first simultaneous thread ($thr1_end)";
234 is_loaded 0, "$here, beginning";
238 is_loaded 1, "$here, after loading";
243 is_loaded 1, "$here, still loaded while also loaded in the other thread";
246 sync_slave 6 unless $first_thread_ends_first;
248 is_loaded 1, "$here, end";
253 skip "$could_not_create_thread (parallel 1)" => (4 * 2) unless defined $thr1;
255 my $thr2 = spawn(sub {
256 my $here = "second simultaneous thread ($thr2_end)";
259 is_loaded 0, "$here, beginning";
264 is_loaded 0, "$here, loaded in other thread but not here";
267 is_loaded 1, "$here, after loading";
271 sync_slave 6 if $first_thread_ends_first;
273 is_loaded 1, "$here, end";
278 sync_master($_) for 0 .. 5;
281 ($thr2, $thr1) = ($thr1, $thr2) unless $first_thread_ends_first;
284 if (my $err = $thr1->error) {
291 if (my $err = $thr1->error) {
295 sync_master(6, 1) unless $first_thread_ends_first;
298 if (my $err = $thr1->error) {
302 skip "$could_not_create_thread (parallel 2)" => (4 * 1);
306 is_loaded 0, 'main body, after simultaneous threads';
312 my $parent = spawn(sub {
313 my $here = 'simple clone, parent thread';
314 is_loaded 0, "$here, beginning";
317 is_loaded 1, "$here, after loading";
320 my $kid = spawn(sub {
321 my $here = 'simple clone, child thread';
323 is_loaded 1, "$here, beginning";
328 skip "$could_not_create_thread (simple clone child)" => 1
332 if (my $err = $kid->error) {
333 die "in child thread: $err\n";
337 is_loaded 1, "$here, after child terminated";
342 skip "$could_not_create_thread (simple clone parent)" => (3 + 1)
343 unless defined $parent;
346 if (my $err = $parent->error) {
351 is_loaded 0, 'main body, after simple clone';
353 # Test clone outliving its parent
359 my $parent = spawn(sub {
360 my $here = 'outliving clone, parent thread';
361 is_loaded 0, "$here, beginning";
364 is_loaded 1, "$here, after loading";
369 my $kid = spawn(sub {
370 my $here = 'outliving clone, child thread';
372 is_loaded 1, "$here, beginning";
376 cond_wait $kid_done until $kid_done;
379 is_loaded 1, "$here, end";
385 $kid_tid = $kid->tid;
388 skip "$could_not_create_thread (outliving clone child)" => 2;
392 is_loaded 1, "$here, end";
397 skip "$could_not_create_thread (outliving clone parent)" => (3 + 2)
398 unless defined $parent;
400 my $kid_tid = $parent->join;
401 if (my $err = $parent->error) {
406 my $kid = threads->object($kid_tid);
408 if ($kid->is_running) {
411 cond_signal $kid_done;
419 is_loaded 0, 'main body, after outliving clone';
422 is_loaded 1, 'main body, loaded at end';