X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FScope-Upper.git;a=blobdiff_plain;f=t%2F09-load-threads.t;h=024e15e4518eec1b6eff6de5f6aa14d390c5f34c;hp=b63a51eb8607fec625bd85849b4c43cd6eb2aeff;hb=bac2d3bafef497b0c64e294795a9e6605fcb6422;hpb=393fc036f99c98cdf1ac25b9f564e1d4c020bbc8

diff --git a/t/09-load-threads.t b/t/09-load-threads.t
index b63a51e..024e15e 100644
--- 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";
@@ -55,18 +57,31 @@ BEGIN {
  )
 }
 
-use Test::Leaner tests => 1 + (2 + 2 * 2) + 6 + (1 + 2 * 4);
+my $could_not_create_thread = 'Could not create thread';
+
+use Test::Leaner tests => 1 + (2 + 2 * 2) + 6 + (2 * 4 + 1) * 2 + 1;
 
 sub is_loaded {
  my ($affirmative, $desc) = @_;
 
  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";
+ }
+
+ unless (is $res, $expected, $desc) {
+  $res      = defined $res ? "'$res'" : 'undef';
+  $expected = "'$expected'";
+  diag("Test '$desc' failed: got $res, expected $expected");
  }
+
+ return;
 }
 
 BEGIN {
@@ -80,72 +95,88 @@ is_loaded 0, 'main body, beginning';
 
 # Test serial loadings
 
-my $thr = spawn(sub {
- my $here = "first serial thread";
- is_loaded 0, "$here, beginning";
+SKIP: {
+ my $thr = spawn(sub {
+  my $here = "first serial thread";
+  is_loaded 0, "$here, beginning";
 
- do_load;
- is_loaded 1, "$here, after loading";
+  do_load;
+  is_loaded 1, "$here, after loading";
 
- return;
-});
+  return;
+ });
 
-$thr->join;
-if (my $err = $thr->error) {
- die $err;
+ skip "$could_not_create_thread (serial 1)" => 2 unless defined $thr;
+
+ $thr->join;
+ if (my $err = $thr->error) {
+  die $err;
+ }
 }
 
 is_loaded 0, 'main body, in between serial loadings';
 
-$thr = spawn(sub {
- my $here = "second serial thread";
- is_loaded 0, "$here, beginning";
+SKIP: {
+ my $thr = spawn(sub {
+  my $here = "second serial thread";
+  is_loaded 0, "$here, beginning";
 
- do_load;
- is_loaded 1, "$here, after loading";
+  do_load;
+  is_loaded 1, "$here, after loading";
 
- return;
-});
+  return;
+ });
 
-$thr->join;
-if (my $err = $thr->error) {
- die $err;
+ skip "$could_not_create_thread (serial 2)" => 2 unless defined $thr;
+
+ $thr->join;
+ if (my $err = $thr->error) {
+  die $err;
+ }
 }
 
 is_loaded 0, 'main body, after serial loadings';
 
 # Test nested loadings
 
-$thr = spawn(sub {
- my $here = 'parent thread';
- is_loaded 0, "$here, beginning";
-
- my $kid = spawn(sub {
-  my $here = 'child thread';
+SKIP: {
+ my $thr = spawn(sub {
+  my $here = 'parent thread';
   is_loaded 0, "$here, beginning";
 
+  SKIP: {
+   my $kid = spawn(sub {
+    my $here = 'child thread';
+    is_loaded 0, "$here, beginning";
+
+    do_load;
+    is_loaded 1, "$here, after loading";
+
+    return;
+   });
+
+   skip "$could_not_create_thread (nested child)" => 2 unless defined $kid;
+
+   $kid->join;
+   if (my $err = $kid->error) {
+    die "in child thread: $err\n";
+   }
+  }
+
+  is_loaded 0, "$here, after child terminated";
+
   do_load;
   is_loaded 1, "$here, after loading";
 
   return;
  });
 
- $kid->join;
- if (my $err = $kid->error) {
-  die "in child thread: $err\n";
- }
-
- is_loaded 0, "$here, after child terminated";
-
- do_load;
- is_loaded 1, "$here, after loading";
-
- return;
-});
+ skip "$could_not_create_thread (nested parent)" => (3 + 2) unless defined $thr;
 
-$thr->join;
-if (my $err = $thr->error) {
- die $err;
+ $thr->join;
+ if (my $err = $thr->error) {
+  die $err;
+ }
 }
 
 is_loaded 0, 'main body, after nested loadings';
@@ -155,16 +186,28 @@ is_loaded 0, 'main body, after nested loadings';
 use threads;
 use threads::shared;
 
-my @locks = (1) x 5;
-share($_) for @locks;
+my $sync_points = 7;
+
+my @locks_down = (1) x $sync_points;
+my @locks_up   = (0) x $sync_points;
+share($_) for @locks_down, @locks_up;
+
+my $default_peers = 2;
 
 sub sync_master {
- my ($id) = @_;
+ my ($id, $peers) = @_;
+
+ $peers = $default_peers unless defined $peers;
+
+ {
+  lock $locks_down[$id];
+  $locks_down[$id] = 0;
+  cond_broadcast $locks_down[$id];
+ }
 
  {
-  lock $locks[$id];
-  $locks[$id] = 0;
-  cond_broadcast $locks[$id];
+  lock $locks_up[$id];
+  cond_wait $locks_up[$id] until $locks_up[$id] == $peers;
  }
 }
 
@@ -172,59 +215,114 @@ 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];
  }
 }
 
-my $thr1 = spawn(sub {
- my $here = 'first simultaneous thread';
- is_loaded 0, "$here, beginning";
- sync_slave 0;
+for my $first_thread_ends_first (0, 1) {
+ for my $id (0 .. $sync_points - 1) {
+  {
+   lock $locks_down[$id];
+   $locks_down[$id] = 1;
+  }
+  {
+   lock $locks_up[$id];
+   $locks_up[$id] = 0;
+  }
+ }
 
- do_load;
- is_loaded 1, "$here, after loading";
- sync_slave 1;
- sync_slave 2;
+ my $thr1_end = 'finishes first';
+ my $thr2_end = 'finishes last';
 
- sync_slave 3;
- is_loaded 1, "$here, still loaded while also loaded in the other thread";
- sync_slave 4;
+ ($thr1_end, $thr2_end) = ($thr2_end, $thr1_end)
+                                                unless $first_thread_ends_first;
 
- is_loaded 1, "$here, end";
+ SKIP: {
+  my $thr1 = spawn(sub {
+   my $here = "first simultaneous thread ($thr1_end)";
+   sync_slave 0;
 
- return;
-});
+   is_loaded 0, "$here, beginning";
+   sync_slave 1;
 
-my $thr2 = spawn(sub {
- my $here = 'second simultaneous thread';
- is_loaded 0, "$here, beginning";
- sync_slave 0;
+   do_load;
+   is_loaded 1, "$here, after loading";
+   sync_slave 2;
+   sync_slave 3;
 
- sync_slave 1;
- is_loaded 0, "$here, loaded in other thread but not here";
- sync_slave 2;
+   sync_slave 4;
+   is_loaded 1, "$here, still loaded while also loaded in the other thread";
+   sync_slave 5;
 
- do_load;
- is_loaded 1, "$here, after loading";
- sync_slave 3;
- sync_slave 4;
+   sync_slave 6 unless $first_thread_ends_first;
 
- is_loaded 1, "$here, end";
+   is_loaded 1, "$here, end";
 
- return;
-});
+   return;
+  });
 
-sync_master($_) for 0 .. $#locks;
+  skip "$could_not_create_thread (parallel 1)" => (4 * 2) unless defined $thr1;
 
-$thr1->join;
-if (my $err = $thr1->error) {
- die $err;
-}
+  my $thr2 = spawn(sub {
+   my $here = "second simultaneous thread ($thr2_end)";
+   sync_slave 0;
+
+   is_loaded 0, "$here, beginning";
+   sync_slave 1;
+
+   sync_slave 2;
+   sync_slave 3;
+   is_loaded 0, "$here, loaded in other thread but not here";
+
+   do_load;
+   is_loaded 1, "$here, after loading";
+   sync_slave 4;
+   sync_slave 5;
+
+   sync_slave 6 if $first_thread_ends_first;
+
+   is_loaded 1, "$here, end";
+
+   return;
+  });
+
+  sync_master($_) for 0 .. 5;
+
+  if (defined $thr2) {
+   ($thr2, $thr1) = ($thr1, $thr2) unless $first_thread_ends_first;
+
+   $thr1->join;
+   if (my $err = $thr1->error) {
+    die $err;
+   }
+
+   sync_master(6, 1);
+
+   $thr2->join;
+   if (my $err = $thr1->error) {
+    die $err;
+   }
+  } else {
+   sync_master(6, 1) unless $first_thread_ends_first;
+
+   $thr1->join;
+   if (my $err = $thr1->error) {
+    die $err;
+   }
+
+   skip "$could_not_create_thread (parallel 2)" => (4 * 1);
+  }
+ }
 
-$thr2->join;
-if (my $err = $thr2->error) {
- die $err;
+ is_loaded 0, 'main body, after simultaneous threads';
 }
 
-is_loaded 0, 'main body, after simultaneous threads';
+do_load;
+is_loaded 1, 'main body, loaded at end';