7 use VPIT::TestHelpers 'run_perl';
9 my ($module, $thread_safe_var);
11 $module = 'Variable::Magic';
12 $thread_safe_var = 'Variable::Magic::VMG_THREADSAFE()';
17 if (defined &Variable::Magic::wizard) {
18 my $wiz = Variable::Magic::wizard(
19 free => sub { $res = 1; return },
22 &Variable::Magic::cast(\$var, $wiz);
28 # Keep the rest of the file untouched
33 if (defined $thread_safe_var) {
34 my $stat = run_perl "require POSIX; require $module; exit($thread_safe_var ? POSIX::EXIT_SUCCESS() : POSIX::EXIT_FAILURE())";
38 if ($res == POSIX::EXIT_SUCCESS()) {
40 } elsif ($res == POSIX::EXIT_FAILURE()) {
44 if (not defined $is_threadsafe) {
45 skip_all "Could not detect if $module is thread safe or not";
49 VPIT::TestHelpers->import(
50 threads => [ $module => $is_threadsafe ],
54 my $could_not_create_thread = 'Could not create thread';
56 use Test::Leaner tests => 1 + (2 + 2 * 2) + 6 + (2 * 4 + 1) * 2 + 1;
59 my ($affirmative, $desc) = @_;
61 my $res = load_test();
66 $desc = "$desc: module loaded";
69 $desc = "$desc: module not loaded";
72 unless (is $res, $expected, $desc) {
73 $res = defined $res ? "'$res'" : 'undef';
74 $expected = "'$expected'";
75 diag("Test '$desc' failed: got $res, expected $expected");
83 my $code = eval "sub { require $module }";
88 is_loaded 0, 'main body, beginning';
90 # Test serial loadings
94 my $here = "first serial thread";
95 is_loaded 0, "$here, beginning";
98 is_loaded 1, "$here, after loading";
103 skip "$could_not_create_thread (serial 1)" => 2 unless defined $thr;
106 if (my $err = $thr->error) {
111 is_loaded 0, 'main body, in between serial loadings';
114 my $thr = spawn(sub {
115 my $here = "second serial thread";
116 is_loaded 0, "$here, beginning";
119 is_loaded 1, "$here, after loading";
124 skip "$could_not_create_thread (serial 2)" => 2 unless defined $thr;
127 if (my $err = $thr->error) {
132 is_loaded 0, 'main body, after serial loadings';
134 # Test nested loadings
137 my $thr = spawn(sub {
138 my $here = 'parent thread';
139 is_loaded 0, "$here, beginning";
142 my $kid = spawn(sub {
143 my $here = 'child thread';
144 is_loaded 0, "$here, beginning";
147 is_loaded 1, "$here, after loading";
152 skip "$could_not_create_thread (nested child)" => 2 unless defined $kid;
155 if (my $err = $kid->error) {
156 die "in child thread: $err\n";
160 is_loaded 0, "$here, after child terminated";
163 is_loaded 1, "$here, after loading";
168 skip "$could_not_create_thread (nested parent)" => (3 + 2) unless defined $thr;
171 if (my $err = $thr->error) {
176 is_loaded 0, 'main body, after nested loadings';
178 # Test parallel loadings
185 my @locks_down = (1) x $sync_points;
186 my @locks_up = (0) x $sync_points;
187 share($_) for @locks_down, @locks_up;
189 my $default_peers = 2;
192 my ($id, $peers) = @_;
194 $peers = $default_peers unless defined $peers;
197 lock $locks_down[$id];
198 $locks_down[$id] = 0;
199 cond_broadcast $locks_down[$id];
204 cond_wait $locks_up[$id] until $locks_up[$id] == $peers;
212 lock $locks_down[$id];
213 cond_wait $locks_down[$id] until $locks_down[$id] == 0;
219 cond_signal $locks_up[$id];
223 for my $first_thread_ends_first (0, 1) {
224 for my $id (0 .. $sync_points - 1) {
226 lock $locks_down[$id];
227 $locks_down[$id] = 1;
235 my $thr1_end = 'finishes first';
236 my $thr2_end = 'finishes last';
238 ($thr1_end, $thr2_end) = ($thr2_end, $thr1_end)
239 unless $first_thread_ends_first;
242 my $thr1 = spawn(sub {
243 my $here = "first simultaneous thread ($thr1_end)";
246 is_loaded 0, "$here, beginning";
250 is_loaded 1, "$here, after loading";
255 is_loaded 1, "$here, still loaded while also loaded in the other thread";
258 sync_slave 6 unless $first_thread_ends_first;
260 is_loaded 1, "$here, end";
265 skip "$could_not_create_thread (parallel 1)" => (4 * 2) unless defined $thr1;
267 my $thr2 = spawn(sub {
268 my $here = "second simultaneous thread ($thr2_end)";
271 is_loaded 0, "$here, beginning";
276 is_loaded 0, "$here, loaded in other thread but not here";
279 is_loaded 1, "$here, after loading";
283 sync_slave 6 if $first_thread_ends_first;
285 is_loaded 1, "$here, end";
290 sync_master($_) for 0 .. 5;
293 ($thr2, $thr1) = ($thr1, $thr2) unless $first_thread_ends_first;
296 if (my $err = $thr1->error) {
303 if (my $err = $thr1->error) {
307 sync_master(6, 1) unless $first_thread_ends_first;
310 if (my $err = $thr1->error) {
314 skip "$could_not_create_thread (parallel 2)" => (4 * 1);
318 is_loaded 0, 'main body, after simultaneous threads';
322 is_loaded 1, 'main body, loaded at end';