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