From: Vincent Pit <vince@profvince.com>
Date: Mon, 20 Apr 2015 14:54:58 +0000 (-0300)
Subject: Update t/09-load-threads.t
X-Git-Tag: rt104751~11
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FScope-Upper.git;a=commitdiff_plain;h=68c46e73d73ad6a23052a7b637163c935c8be396

Update t/09-load-threads.t

It now also exercises cloning.
---

diff --git a/t/09-load-threads.t b/t/09-load-threads.t
index acbf7e4..a4721a8 100644
--- a/t/09-load-threads.t
+++ b/t/09-load-threads.t
@@ -35,7 +35,9 @@ 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 (
+ tests => 1 + (2 + 2 * 2) + 6 + (2 * 4 + 1) * 2 + (4 + 1) + (6 + 1) + 1
+);
 
 sub is_loaded {
  my ($affirmative, $desc) = @_;
@@ -116,7 +118,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";
 
@@ -147,10 +149,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;
  }
 }
@@ -300,5 +303,132 @@ 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_tid;
+ share($kid_tid);
+
+ my $kid_done;
+ share($kid_done);
+
+ my $parent = spawn(sub {
+  my $here = 'outliving clone, parent thread';
+  is_loaded 0, "$here, beginning";
+
+  my $no_kid;
+
+  do_load;
+  is_loaded 1, "$here, after loading";
+
+  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;
+    }
+
+    is_loaded 1, "$here, end";
+
+    return;
+   });
+
+   unless (defined $kid) {
+    $no_kid = 1;
+    skip "$could_not_create_thread (outliving clone child)" => 3;
+   }
+  }
+
+  is_loaded 1, "$here, end";
+
+  return $no_kid;
+ });
+
+ skip "$could_not_create_thread (outliving clone parent)" => (3 + 3)
+                                                         unless defined $parent;
+
+ my $no_kid = $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 (defined $kid) {
+   {
+    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';