]> git.vpit.fr Git - perl/modules/indirect.git/blobdiff - t/09-load-threads.t
Improve diagnostics in t/09-load-threads.t in case of failure
[perl/modules/indirect.git] / t / 09-load-threads.t
index d0e43221b8a618aaa28813d0efe47902ef2e61ca..7575b2dcec583f2304a079ee7fdb473517d9eb10 100644 (file)
@@ -65,11 +65,19 @@ sub is_loaded {
 
  my $res = load_test();
 
+ my $expected;
  if ($affirmative) {
-  is $res, 1, "$desc: module loaded";
+  $expected = 1;
+  $desc     = "$desc: module loaded";
  } else {
-  is $res, 0, "$desc: module not loaded";
+  $expected = 0;
+  $desc     = "$desc: module not loaded";
  }
+
+ is($res, $expected, $desc)
+               or diag("Test '$desc' failed: got '$res', expected '$expected'");
+
+ return;
 }
 
 BEGIN {
@@ -174,16 +182,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;
  }
 }
 
@@ -191,8 +207,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];
  }
 }
 
@@ -237,7 +259,7 @@ SKIP: {
   return;
  });
 
- sync_master($_) for 0 .. $#locks;
+ sync_master($_) for 0 .. $#locks_down;
 
  $thr1->join;
  if (my $err = $thr1->error) {