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) + 2;
59 my ($affirmative, $desc) = @_;
61 my $res = load_test();
64 is $res, 1, "$desc: module loaded";
66 is $res, 0, "$desc: module not loaded";
72 my $code = eval "sub { require $module }";
77 is_loaded 0, 'main body, beginning';
79 # Test serial loadings
83 my $here = "first serial thread";
84 is_loaded 0, "$here, beginning";
87 is_loaded 1, "$here, after loading";
92 skip "$could_not_create_thread (serial 1)" => 2 unless defined $thr;
95 if (my $err = $thr->error) {
100 is_loaded 0, 'main body, in between serial loadings';
103 my $thr = spawn(sub {
104 my $here = "second serial thread";
105 is_loaded 0, "$here, beginning";
108 is_loaded 1, "$here, after loading";
113 skip "$could_not_create_thread (serial 2)" => 2 unless defined $thr;
116 if (my $err = $thr->error) {
121 is_loaded 0, 'main body, after serial loadings';
123 # Test nested loadings
126 my $thr = spawn(sub {
127 my $here = 'parent thread';
128 is_loaded 0, "$here, beginning";
131 my $kid = spawn(sub {
132 my $here = 'child thread';
133 is_loaded 0, "$here, beginning";
136 is_loaded 1, "$here, after loading";
141 skip "$could_not_create_thread (nested child)" => 2 unless defined $kid;
144 if (my $err = $kid->error) {
145 die "in child thread: $err\n";
149 is_loaded 0, "$here, after child terminated";
152 is_loaded 1, "$here, after loading";
157 skip "$could_not_create_thread (nested parent)" => (3 + 2) unless defined $thr;
160 if (my $err = $thr->error) {
165 is_loaded 0, 'main body, after nested loadings';
167 # Test parallel loadings
172 my @locks_down = (1) x 5;
173 my @locks_up = (0) x scalar @locks_down;
174 share($_) for @locks_down, @locks_up;
182 lock $locks_down[$id];
183 $locks_down[$id] = 0;
184 cond_broadcast $locks_down[$id];
189 cond_wait $locks_up[$id] until $locks_up[$id] == $peers;
197 lock $locks_down[$id];
198 cond_wait $locks_down[$id] until $locks_down[$id] == 0;
204 cond_signal $locks_up[$id];
209 my $thr1 = spawn(sub {
210 my $here = 'first simultaneous thread';
211 is_loaded 0, "$here, beginning";
215 is_loaded 1, "$here, after loading";
220 is_loaded 1, "$here, still loaded while also loaded in the other thread";
223 is_loaded 1, "$here, end";
228 skip "$could_not_create_thread (parallel 1)" => (4 * 2) unless defined $thr1;
230 my $thr2 = spawn(sub {
231 my $here = 'second simultaneous thread';
232 is_loaded 0, "$here, beginning";
236 is_loaded 0, "$here, loaded in other thread but not here";
240 is_loaded 1, "$here, after loading";
244 is_loaded 1, "$here, end";
249 sync_master($_) for 0 .. $#locks_down;
252 if (my $err = $thr1->error) {
256 skip "$could_not_create_thread (parallel 2)" => (4 * 1) unless defined $thr2;
259 if (my $err = $thr2->error) {
264 is_loaded 0, 'main body, after simultaneous threads';
267 is_loaded 1, 'main body, loaded at end';