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';
32 use Test::Leaner tests => 1 + (2 + 2 * 2) + 6 + (2 * 4 + 1) * 2 + 1;
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 $thr = 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) unless defined $thr;
147 if (my $err = $thr->error) {
152 is_loaded 0, 'main body, after nested loadings';
154 # Test parallel loadings
161 my @locks_down = (1) x $sync_points;
162 my @locks_up = (0) x $sync_points;
163 share($_) for @locks_down, @locks_up;
165 my $default_peers = 2;
168 my ($id, $peers) = @_;
170 $peers = $default_peers unless defined $peers;
173 lock $locks_down[$id];
174 $locks_down[$id] = 0;
175 cond_broadcast $locks_down[$id];
180 cond_wait $locks_up[$id] until $locks_up[$id] == $peers;
188 lock $locks_down[$id];
189 cond_wait $locks_down[$id] until $locks_down[$id] == 0;
195 cond_signal $locks_up[$id];
199 for my $first_thread_ends_first (0, 1) {
200 for my $id (0 .. $sync_points - 1) {
202 lock $locks_down[$id];
203 $locks_down[$id] = 1;
211 my $thr1_end = 'finishes first';
212 my $thr2_end = 'finishes last';
214 ($thr1_end, $thr2_end) = ($thr2_end, $thr1_end)
215 unless $first_thread_ends_first;
218 my $thr1 = spawn(sub {
219 my $here = "first simultaneous thread ($thr1_end)";
222 is_loaded 0, "$here, beginning";
226 is_loaded 1, "$here, after loading";
231 is_loaded 1, "$here, still loaded while also loaded in the other thread";
234 sync_slave 6 unless $first_thread_ends_first;
236 is_loaded 1, "$here, end";
241 skip "$could_not_create_thread (parallel 1)" => (4 * 2) unless defined $thr1;
243 my $thr2 = spawn(sub {
244 my $here = "second simultaneous thread ($thr2_end)";
247 is_loaded 0, "$here, beginning";
252 is_loaded 0, "$here, loaded in other thread but not here";
255 is_loaded 1, "$here, after loading";
259 sync_slave 6 if $first_thread_ends_first;
261 is_loaded 1, "$here, end";
266 sync_master($_) for 0 .. 5;
269 ($thr2, $thr1) = ($thr1, $thr2) unless $first_thread_ends_first;
272 if (my $err = $thr1->error) {
279 if (my $err = $thr1->error) {
283 sync_master(6, 1) unless $first_thread_ends_first;
286 if (my $err = $thr1->error) {
290 skip "$could_not_create_thread (parallel 2)" => (4 * 1);
294 is_loaded 0, 'main body, after simultaneous threads';
298 is_loaded 1, 'main body, loaded at end';