X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F09-load-threads.t;h=60d6acf1499c30757e77ad51ae3b4cd7fca6f4f3;hb=0aba0d53f2d474b5ae53796000cc42b666d3983e;hp=b7b7dff199cc4799a39a06b65c1093e710dd9200;hpb=6b6230fb9d11ea82ed446c666b4272ad979b900b;p=perl%2Fmodules%2FVariable-Magic.git

diff --git a/t/09-load-threads.t b/t/09-load-threads.t
index b7b7dff..60d6acf 100644
--- a/t/09-load-threads.t
+++ b/t/09-load-threads.t
@@ -29,9 +29,7 @@ use VPIT::TestHelpers threads => [ $module, $thread_safe_var ];
 
 my $could_not_create_thread = 'Could not create thread';
 
-use Test::Leaner (
- tests => 1 + (2 + 2 * 2) + 6 + (2 * 4 + 1) * 2 + (4 + 1) + (6 + 1) + 1
-);
+use Test::Leaner;
 
 sub is_loaded {
  my ($affirmative, $desc) = @_;
@@ -112,7 +110,7 @@ is_loaded 0, 'main body, after serial loadings';
 # Test nested loadings
 
 SKIP: {
- my $thr = spawn(sub {
+ my $parent = spawn(sub {
   my $here = 'parent thread';
   is_loaded 0, "$here, beginning";
 
@@ -143,10 +141,11 @@ SKIP: {
   return;
  });
 
- skip "$could_not_create_thread (nested parent)" => (3 + 2) unless defined $thr;
+ skip "$could_not_create_thread (nested parent)" => (3 + 2)
+                                                         unless defined $parent;
 
- $thr->join;
- if (my $err = $thr->error) {
+ $parent->join;
+ if (my $err = $parent->error) {
   die $err;
  }
 }
@@ -177,10 +176,19 @@ sub sync_master {
   cond_broadcast $locks_down[$id];
  }
 
- {
+ LOCK: {
   lock $locks_up[$id];
-  cond_wait $locks_up[$id] until $locks_up[$id] == $peers;
+  my $timeout = time() + 10;
+  until ($locks_up[$id] == $peers) {
+   if (cond_timedwait $locks_up[$id], $timeout) {
+    last LOCK;
+   } else {
+    return 0;
+   }
+  }
  }
+
+ return 1;
 }
 
 sub sync_slave {
@@ -196,6 +204,8 @@ sub sync_slave {
   $locks_up[$id]++;
   cond_signal $locks_up[$id];
  }
+
+ return 1;
 }
 
 for my $first_thread_ends_first (0, 1) {
@@ -237,7 +247,7 @@ for my $first_thread_ends_first (0, 1) {
 
    is_loaded 1, "$here, end";
 
-   return;
+   return 1;
   });
 
   skip "$could_not_create_thread (parallel 1)" => (4 * 2) unless defined $thr1;
@@ -262,7 +272,7 @@ for my $first_thread_ends_first (0, 1) {
 
    is_loaded 1, "$here, end";
 
-   return;
+   return 1;
   });
 
   sync_master($_) for 0 .. 5;
@@ -343,9 +353,6 @@ is_loaded 0, 'main body, after simple clone';
 # Test clone outliving its parent
 
 SKIP: {
- my $kid_tid;
- share($kid_tid);
-
  my $kid_done;
  share($kid_done);
 
@@ -353,25 +360,17 @@ SKIP: {
   my $here = 'outliving clone, parent thread';
   is_loaded 0, "$here, beginning";
 
-  my $no_kid;
-
   do_load;
   is_loaded 1, "$here, after loading";
 
+  my $kid_tid;
+
   SKIP: {
    my $kid = spawn(sub {
     my $here = 'outliving clone, child thread';
 
     is_loaded 1, "$here, beginning";
 
-    {
-     lock $kid_tid;
-     $kid_tid = threads->tid();
-     cond_signal $kid_tid;
-    }
-
-    is_loaded 1, "$here, kid tid was communicated";
-
     {
      lock $kid_done;
      cond_wait $kid_done until $kid_done;
@@ -379,38 +378,34 @@ SKIP: {
 
     is_loaded 1, "$here, end";
 
-    return;
+    return 1;
    });
 
-   unless (defined $kid) {
-    $no_kid = 1;
-    skip "$could_not_create_thread (outliving clone child)" => 3;
+   if (defined $kid) {
+    $kid_tid = $kid->tid;
+   } else {
+    $kid_tid = 0;
+    skip "$could_not_create_thread (outliving clone child)" => 2;
    }
   }
 
   is_loaded 1, "$here, end";
 
-  return $no_kid;
+  return $kid_tid;
  });
 
- skip "$could_not_create_thread (outliving clone parent)" => (3 + 3)
+ skip "$could_not_create_thread (outliving clone parent)" => (3 + 2)
                                                          unless defined $parent;
 
- my $no_kid = $parent->join;
+ my $kid_tid = $parent->join;
  if (my $err = $parent->error) {
   die $err;
  }
 
- unless ($no_kid) {
-  my $tid = do {
-   lock $kid_tid;
-   cond_wait $kid_tid until defined $kid_tid;
-   $kid_tid;
-  };
-
-  my $kid = threads->object($tid);
+ if ($kid_tid) {
+  my $kid = threads->object($kid_tid);
   if (defined $kid) {
-   {
+   if ($kid->is_running) {
     lock $kid_done;
     $kid_done = 1;
     cond_signal $kid_done;
@@ -425,3 +420,7 @@ is_loaded 0, 'main body, after outliving clone';
 
 do_load;
 is_loaded 1, 'main body, loaded at end';
+
+# perl 5.13.4 comes a Test::More more recent than 0.88, so it must have
+# done_testing() and Test::Leaner will not replace it by a croaking stub.
+done_testing();