X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F09-load-threads.t;h=54485df95594483a9695eb991cf4f0b616681f0a;hb=b88a054e2ca91c186a420e015b3a383b406ff2d0;hp=0d474d58d449b74a52468af90f470aee14c7fbc0;hpb=db575876ebae52b20a4f2e7c6113ea92c2798ca2;p=perl%2Fmodules%2Findirect.git

diff --git a/t/09-load-threads.t b/t/09-load-threads.t
index 0d474d5..54485df 100644
--- a/t/09-load-threads.t
+++ b/t/09-load-threads.t
@@ -3,9 +3,6 @@
 use strict;
 use warnings;
 
-use lib 't/lib';
-use VPIT::TestHelpers;
-
 BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
 
 my ($module, $thread_safe_var);
@@ -32,33 +29,12 @@ sub load_test {
 
 # Keep the rest of the file untouched
 
-BEGIN {
- my $is_threadsafe;
-
- if (defined $thread_safe_var) {
-  my $stat = run_perl "require POSIX; require $module; exit($thread_safe_var ? POSIX::EXIT_SUCCESS() : POSIX::EXIT_FAILURE())";
-  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";
-  }
- }
-
- VPIT::TestHelpers->import(
-  threads => [ $module => $is_threadsafe ],
- )
-}
+use lib 't/lib';
+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 + 1;
+use Test::Leaner;
 
 sub is_loaded {
  my ($affirmative, $desc) = @_;
@@ -139,7 +115,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";
 
@@ -170,10 +146,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;
  }
 }
@@ -204,10 +181,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 {
@@ -223,6 +209,8 @@ sub sync_slave {
   $locks_up[$id]++;
   cond_signal $locks_up[$id];
  }
+
+ return 1;
 }
 
 for my $first_thread_ends_first (0, 1) {
@@ -264,7 +252,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;
@@ -289,7 +277,7 @@ for my $first_thread_ends_first (0, 1) {
 
    is_loaded 1, "$here, end";
 
-   return;
+   return 1;
   });
 
   sync_master($_) for 0 .. 5;
@@ -323,5 +311,119 @@ for my $first_thread_ends_first (0, 1) {
  is_loaded 0, 'main body, after simultaneous threads';
 }
 
+# Test simple clone
+
+SKIP: {
+ my $parent = spawn(sub {
+  my $here = 'simple clone, parent thread';
+  is_loaded 0, "$here, beginning";
+
+  do_load;
+  is_loaded 1, "$here, after loading";
+
+  SKIP: {
+   my $kid = spawn(sub {
+    my $here = 'simple clone, child thread';
+
+    is_loaded 1, "$here, beginning";
+
+    return;
+   });
+
+   skip "$could_not_create_thread (simple clone child)" => 1
+                                                            unless defined $kid;
+
+   $kid->join;
+   if (my $err = $kid->error) {
+    die "in child thread: $err\n";
+   }
+  }
+
+  is_loaded 1, "$here, after child terminated";
+
+  return;
+ });
+
+ skip "$could_not_create_thread (simple clone parent)" => (3 + 1)
+                                                         unless defined $parent;
+
+ $parent->join;
+ if (my $err = $parent->error) {
+  die $err;
+ }
+}
+
+is_loaded 0, 'main body, after simple clone';
+
+# Test clone outliving its parent
+
+SKIP: {
+ my $kid_done;
+ share($kid_done);
+
+ my $parent = spawn(sub {
+  my $here = 'outliving clone, parent thread';
+  is_loaded 0, "$here, beginning";
+
+  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_done;
+     cond_wait $kid_done until $kid_done;
+    }
+
+    is_loaded 1, "$here, end";
+
+    return 1;
+   });
+
+   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 $kid_tid;
+ });
+
+ skip "$could_not_create_thread (outliving clone parent)" => (3 + 2)
+                                                         unless defined $parent;
+
+ my $kid_tid = $parent->join;
+ if (my $err = $parent->error) {
+  die $err;
+ }
+
+ 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;
+   }
+
+   $kid->join;
+  }
+ }
+}
+
+is_loaded 0, 'main body, after outliving clone';
+
 do_load;
 is_loaded 1, 'main body, loaded at end';
+
+done_testing();