9 BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
11 my ($module, $thread_safe_var);
14 $thread_safe_var = 'indirect::I_THREADSAFE()';
19 if (defined &indirect::msg) {
21 eval 'BEGIN { indirect->unimport(":fatal") if defined &indirect::msg } return; my $x = new X;';
24 if (defined $res and $res =~ /^Indirect call of method/) {
26 } elsif (not defined $res or $res eq '') {
33 # Keep the rest of the file untouched
38 if (defined $thread_safe_var) {
39 my $stat = run_perl "require POSIX; require $module; exit($thread_safe_var ? POSIX::EXIT_SUCCESS() : POSIX::EXIT_FAILURE())";
43 if ($res == POSIX::EXIT_SUCCESS()) {
45 } elsif ($res == POSIX::EXIT_FAILURE()) {
49 if (not defined $is_threadsafe) {
50 skip_all "Could not detect if $module is thread safe or not";
54 VPIT::TestHelpers->import(
55 threads => [ $module => $is_threadsafe ],
59 my $could_not_create_thread = 'Could not create thread';
61 use Test::Leaner tests => 1 + (2 + 2 * 2) + 6 + (2 * 4) + 2;
64 my ($affirmative, $desc) = @_;
66 my $res = load_test();
69 is $res, 1, "$desc: module loaded";
71 is $res, 0, "$desc: module not loaded";
77 my $code = eval "sub { require $module }";
82 is_loaded 0, 'main body, beginning';
84 # Test serial loadings
88 my $here = "first serial thread";
89 is_loaded 0, "$here, beginning";
92 is_loaded 1, "$here, after loading";
97 skip "$could_not_create_thread (serial 1)" => 2 unless defined $thr;
100 if (my $err = $thr->error) {
105 is_loaded 0, 'main body, in between serial loadings';
108 my $thr = spawn(sub {
109 my $here = "second serial thread";
110 is_loaded 0, "$here, beginning";
113 is_loaded 1, "$here, after loading";
118 skip "$could_not_create_thread (serial 2)" => 2 unless defined $thr;
121 if (my $err = $thr->error) {
126 is_loaded 0, 'main body, after serial loadings';
128 # Test nested loadings
131 my $thr = spawn(sub {
132 my $here = 'parent thread';
133 is_loaded 0, "$here, beginning";
136 my $kid = spawn(sub {
137 my $here = 'child thread';
138 is_loaded 0, "$here, beginning";
141 is_loaded 1, "$here, after loading";
146 skip "$could_not_create_thread (nested child)" => 2 unless defined $kid;
149 if (my $err = $kid->error) {
150 die "in child thread: $err\n";
154 is_loaded 0, "$here, after child terminated";
157 is_loaded 1, "$here, after loading";
162 skip "$could_not_create_thread (nested parent)" => (3 + 2) unless defined $thr;
165 if (my $err = $thr->error) {
170 is_loaded 0, 'main body, after nested loadings';
172 # Test parallel loadings
178 share($_) for @locks;
186 cond_broadcast $locks[$id];
195 cond_wait $locks[$id] until $locks[$id] == 0;
200 my $thr1 = spawn(sub {
201 my $here = 'first simultaneous thread';
202 is_loaded 0, "$here, beginning";
206 is_loaded 1, "$here, after loading";
211 is_loaded 1, "$here, still loaded while also loaded in the other thread";
214 is_loaded 1, "$here, end";
219 skip "$could_not_create_thread (parallel 1)" => (4 * 2) unless defined $thr1;
221 my $thr2 = spawn(sub {
222 my $here = 'second simultaneous thread';
223 is_loaded 0, "$here, beginning";
227 is_loaded 0, "$here, loaded in other thread but not here";
231 is_loaded 1, "$here, after loading";
235 is_loaded 1, "$here, end";
240 sync_master($_) for 0 .. $#locks;
243 if (my $err = $thr1->error) {
247 skip "$could_not_create_thread (parallel 2)" => (4 * 1) unless defined $thr2;
250 if (my $err = $thr2->error) {
255 is_loaded 0, 'main body, after simultaneous threads';
258 is_loaded 1, 'main body, loaded at end';