Improve scheduling for the parallel loading test

[perl/modules/Scope-Upper.git] / t / 09-load-threads.t

diff --git a/t/09-load-threads.t b/t/09-load-threads.t
index 89cf8d3acf2522b3a2c29367b5c0e561d5e0d274..9821d91ca51dffcfa2abc3a207b21248585c7de6 100644 (file)
--- a/t/09-load-threads.t
+++ b/t/09-load-threads.t
@@ -38,12 +38,14 @@ BEGIN {
 
  if (defined $thread_safe_var) {
   my $stat = run_perl "require POSIX; require $module; exit($thread_safe_var ? POSIX::EXIT_SUCCESS() : POSIX::EXIT_FAILURE())";
-  require POSIX;
-  my $res  = $stat >> 8;
-  if ($res == POSIX::EXIT_SUCCESS()) {
-   $is_threadsafe = 1;
-  } elsif ($res == POSIX::EXIT_FAILURE()) {
-   $is_threadsafe = !1;
+  if (defined $stat) {
+   require POSIX;
+   my $res  = $stat >> 8;
+   if ($res == POSIX::EXIT_SUCCESS()) {
+    $is_threadsafe = 1;
+   } elsif ($res == POSIX::EXIT_FAILURE()) {
+    $is_threadsafe = !1;
+   }
   }
   if (not defined $is_threadsafe) {
    skip_all "Could not detect if $module is thread safe or not";
@@ -173,16 +175,24 @@ is_loaded 0, 'main body, after nested loadings';
 use threads;
 use threads::shared;
 
-my @locks = (1) x 5;
-share($_) for @locks;
+my @locks_down = (1) x 5;
+my @locks_up   = (0) x scalar @locks_down;
+share($_) for @locks_down, @locks_up;
+
+my $peers = 2;
 
 sub sync_master {
  my ($id) = @_;
 
  {
-  lock $locks[$id];
-  $locks[$id] = 0;
-  cond_broadcast $locks[$id];
+  lock $locks_down[$id];
+  $locks_down[$id] = 0;
+  cond_broadcast $locks_down[$id];
+ }
+
+ {
+  lock $locks_up[$id];
+  cond_wait $locks_up[$id] until $locks_up[$id] == $peers;
  }
 }
 
@@ -190,8 +200,14 @@ sub sync_slave {
  my ($id) = @_;
 
  {
-  lock $locks[$id];
-  cond_wait $locks[$id] until $locks[$id] == 0;
+  lock $locks_down[$id];
+  cond_wait $locks_down[$id] until $locks_down[$id] == 0;
+ }
+
+ {
+  lock $locks_up[$id];
+  $locks_up[$id]++;
+  cond_signal $locks_up[$id];
  }
 }
 
@@ -236,7 +252,7 @@ SKIP: {
   return;
  });
 
- sync_master($_) for 0 .. $#locks;
+ sync_master($_) for 0 .. $#locks_down;
 
  $thr1->join;
  if (my $err = $thr1->error) {