t/09-load-threads.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use lib 't/lib';
   7 use VPIT::TestHelpers;
   8
   9 my ($module, $thread_safe_var);
  10 BEGIN {
  11  $module          = 'Scope::Upper';
  12  $thread_safe_var = 'Scope::Upper::SU_THREADSAFE()';
  13 }
  14
  15 sub load_test {
  16  my $res;
  17  {
  18   my $var = 0;
  19   if (defined &Scope::Upper::reap) {
  20    &Scope::Upper::reap(sub { $var *= 2 });
  21    $var = 1;
  22   }
  23   $res = $var;
  24  }
  25  if ($res == 2) {
  26   return 1;
  27  } elsif ($res == 1) {
  28   return 2;
  29  } else {
  30   return $res;
  31  }
  32 }
  33
  34 # Keep the rest of the file untouched
  35
  36 BEGIN {
  37  my $is_threadsafe;
  38
  39  if (defined $thread_safe_var) {
  40   my $stat = run_perl "require POSIX; require $module; exit($thread_safe_var ? POSIX::EXIT_SUCCESS() : POSIX::EXIT_FAILURE())";
  41   if (defined $stat) {
  42    require POSIX;
  43    my $res  = $stat >> 8;
  44    if ($res == POSIX::EXIT_SUCCESS()) {
  45     $is_threadsafe = 1;
  46    } elsif ($res == POSIX::EXIT_FAILURE()) {
  47     $is_threadsafe = !1;
  48    }
  49   }
  50   if (not defined $is_threadsafe) {
  51    skip_all "Could not detect if $module is thread safe or not";
  52   }
  53  }
  54
  55  VPIT::TestHelpers->import(
  56   threads => [ $module => $is_threadsafe ],
  57  )
  58 }
  59
  60 my $could_not_create_thread = 'Could not create thread';
  61
  62 use Test::Leaner tests => 1 + (2 + 2 * 2) + 6 + (2 * 4) + 2;
  63
  64 sub is_loaded {
  65  my ($affirmative, $desc) = @_;
  66
  67  my $res = load_test();
  68
  69  if ($affirmative) {
  70   is $res, 1, "$desc: module loaded";
  71  } else {
  72   is $res, 0, "$desc: module not loaded";
  73  }
  74 }
  75
  76 BEGIN {
  77  local $@;
  78  my $code = eval "sub { require $module }";
  79  die $@ if $@;
  80  *do_load = $code;
  81 }
  82
  83 is_loaded 0, 'main body, beginning';
  84
  85 # Test serial loadings
  86
  87 SKIP: {
  88  my $thr = spawn(sub {
  89   my $here = "first serial thread";
  90   is_loaded 0, "$here, beginning";
  91
  92   do_load;
  93   is_loaded 1, "$here, after loading";
  94
  95   return;
  96  });
  97
  98  skip "$could_not_create_thread (serial 1)" => 2 unless defined $thr;
  99
 100  $thr->join;
 101  if (my $err = $thr->error) {
 102   die $err;
 103  }
 104 }
 105
 106 is_loaded 0, 'main body, in between serial loadings';
 107
 108 SKIP: {
 109  my $thr = spawn(sub {
 110   my $here = "second serial thread";
 111   is_loaded 0, "$here, beginning";
 112
 113   do_load;
 114   is_loaded 1, "$here, after loading";
 115
 116   return;
 117  });
 118
 119  skip "$could_not_create_thread (serial 2)" => 2 unless defined $thr;
 120
 121  $thr->join;
 122  if (my $err = $thr->error) {
 123   die $err;
 124  }
 125 }
 126
 127 is_loaded 0, 'main body, after serial loadings';
 128
 129 # Test nested loadings
 130
 131 SKIP: {
 132  my $thr = spawn(sub {
 133   my $here = 'parent thread';
 134   is_loaded 0, "$here, beginning";
 135
 136   SKIP: {
 137    my $kid = spawn(sub {
 138     my $here = 'child thread';
 139     is_loaded 0, "$here, beginning";
 140
 141     do_load;
 142     is_loaded 1, "$here, after loading";
 143
 144     return;
 145    });
 146
 147    skip "$could_not_create_thread (nested child)" => 2 unless defined $kid;
 148
 149    $kid->join;
 150    if (my $err = $kid->error) {
 151     die "in child thread: $err\n";
 152    }
 153   }
 154
 155   is_loaded 0, "$here, after child terminated";
 156
 157   do_load;
 158   is_loaded 1, "$here, after loading";
 159
 160   return;
 161  });
 162
 163  skip "$could_not_create_thread (nested parent)" => (3 + 2) unless defined $thr;
 164
 165  $thr->join;
 166  if (my $err = $thr->error) {
 167   die $err;
 168  }
 169 }
 170
 171 is_loaded 0, 'main body, after nested loadings';
 172
 173 # Test parallel loadings
 174
 175 use threads;
 176 use threads::shared;
 177
 178 my @locks_down = (1) x 5;
 179 my @locks_up   = (0) x scalar @locks_down;
 180 share($_) for @locks_down, @locks_up;
 181
 182 my $peers = 2;
 183
 184 sub sync_master {
 185  my ($id) = @_;
 186
 187  {
 188   lock $locks_down[$id];
 189   $locks_down[$id] = 0;
 190   cond_broadcast $locks_down[$id];
 191  }
 192
 193  {
 194   lock $locks_up[$id];
 195   cond_wait $locks_up[$id] until $locks_up[$id] == $peers;
 196  }
 197 }
 198
 199 sub sync_slave {
 200  my ($id) = @_;
 201
 202  {
 203   lock $locks_down[$id];
 204   cond_wait $locks_down[$id] until $locks_down[$id] == 0;
 205  }
 206
 207  {
 208   lock $locks_up[$id];
 209   $locks_up[$id]++;
 210   cond_signal $locks_up[$id];
 211  }
 212 }
 213
 214 SKIP: {
 215  my $thr1 = spawn(sub {
 216   my $here = 'first simultaneous thread';
 217   is_loaded 0, "$here, beginning";
 218   sync_slave 0;
 219
 220   do_load;
 221   is_loaded 1, "$here, after loading";
 222   sync_slave 1;
 223   sync_slave 2;
 224
 225   sync_slave 3;
 226   is_loaded 1, "$here, still loaded while also loaded in the other thread";
 227   sync_slave 4;
 228
 229   is_loaded 1, "$here, end";
 230
 231   return;
 232  });
 233
 234  skip "$could_not_create_thread (parallel 1)" => (4 * 2) unless defined $thr1;
 235
 236  my $thr2 = spawn(sub {
 237   my $here = 'second simultaneous thread';
 238   is_loaded 0, "$here, beginning";
 239   sync_slave 0;
 240
 241   sync_slave 1;
 242   is_loaded 0, "$here, loaded in other thread but not here";
 243   sync_slave 2;
 244
 245   do_load;
 246   is_loaded 1, "$here, after loading";
 247   sync_slave 3;
 248   sync_slave 4;
 249
 250   is_loaded 1, "$here, end";
 251
 252   return;
 253  });
 254
 255  sync_master($_) for 0 .. $#locks_down;
 256
 257  $thr1->join;
 258  if (my $err = $thr1->error) {
 259   die $err;
 260  }
 261
 262  skip "$could_not_create_thread (parallel 2)" => (4 * 1) unless defined $thr2;
 263
 264  $thr2->join;
 265  if (my $err = $thr2->error) {
 266   die $err;
 267  }
 268 }
 269
 270 is_loaded 0, 'main body, after simultaneous threads';
 271
 272 do_load;
 273 is_loaded 1, 'main body, loaded at end';