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