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 + 1) * 2 + 1;
  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  unless (is $res, $expected, $desc) {
  78   $res      = defined $res ? "'$res'" : 'undef';
  79   $expected = "'$expected'";
  80   diag("Test '$desc' failed: got $res, expected $expected");
  81  }
  82
  83  return;
  84 }
  85
  86 BEGIN {
  87  local $@;
  88  my $code = eval "sub { require $module }";
  89  die $@ if $@;
  90  *do_load = $code;
  91 }
  92
  93 is_loaded 0, 'main body, beginning';
  94
  95 # Test serial loadings
  96
  97 SKIP: {
  98  my $thr = spawn(sub {
  99   my $here = "first serial thread";
 100   is_loaded 0, "$here, beginning";
 101
 102   do_load;
 103   is_loaded 1, "$here, after loading";
 104
 105   return;
 106  });
 107
 108  skip "$could_not_create_thread (serial 1)" => 2 unless defined $thr;
 109
 110  $thr->join;
 111  if (my $err = $thr->error) {
 112   die $err;
 113  }
 114 }
 115
 116 is_loaded 0, 'main body, in between serial loadings';
 117
 118 SKIP: {
 119  my $thr = spawn(sub {
 120   my $here = "second serial thread";
 121   is_loaded 0, "$here, beginning";
 122
 123   do_load;
 124   is_loaded 1, "$here, after loading";
 125
 126   return;
 127  });
 128
 129  skip "$could_not_create_thread (serial 2)" => 2 unless defined $thr;
 130
 131  $thr->join;
 132  if (my $err = $thr->error) {
 133   die $err;
 134  }
 135 }
 136
 137 is_loaded 0, 'main body, after serial loadings';
 138
 139 # Test nested loadings
 140
 141 SKIP: {
 142  my $thr = spawn(sub {
 143   my $here = 'parent thread';
 144   is_loaded 0, "$here, beginning";
 145
 146   SKIP: {
 147    my $kid = spawn(sub {
 148     my $here = 'child thread';
 149     is_loaded 0, "$here, beginning";
 150
 151     do_load;
 152     is_loaded 1, "$here, after loading";
 153
 154     return;
 155    });
 156
 157    skip "$could_not_create_thread (nested child)" => 2 unless defined $kid;
 158
 159    $kid->join;
 160    if (my $err = $kid->error) {
 161     die "in child thread: $err\n";
 162    }
 163   }
 164
 165   is_loaded 0, "$here, after child terminated";
 166
 167   do_load;
 168   is_loaded 1, "$here, after loading";
 169
 170   return;
 171  });
 172
 173  skip "$could_not_create_thread (nested parent)" => (3 + 2) unless defined $thr;
 174
 175  $thr->join;
 176  if (my $err = $thr->error) {
 177   die $err;
 178  }
 179 }
 180
 181 is_loaded 0, 'main body, after nested loadings';
 182
 183 # Test parallel loadings
 184
 185 use threads;
 186 use threads::shared;
 187
 188 my $sync_points = 7;
 189
 190 my @locks_down = (1) x $sync_points;
 191 my @locks_up   = (0) x $sync_points;
 192 share($_) for @locks_down, @locks_up;
 193
 194 my $default_peers = 2;
 195
 196 sub sync_master {
 197  my ($id, $peers) = @_;
 198
 199  $peers = $default_peers unless defined $peers;
 200
 201  {
 202   lock $locks_down[$id];
 203   $locks_down[$id] = 0;
 204   cond_broadcast $locks_down[$id];
 205  }
 206
 207  {
 208   lock $locks_up[$id];
 209   cond_wait $locks_up[$id] until $locks_up[$id] == $peers;
 210  }
 211 }
 212
 213 sub sync_slave {
 214  my ($id) = @_;
 215
 216  {
 217   lock $locks_down[$id];
 218   cond_wait $locks_down[$id] until $locks_down[$id] == 0;
 219  }
 220
 221  {
 222   lock $locks_up[$id];
 223   $locks_up[$id]++;
 224   cond_signal $locks_up[$id];
 225  }
 226 }
 227
 228 for my $first_thread_ends_first (0, 1) {
 229  for my $id (0 .. $sync_points - 1) {
 230   {
 231    lock $locks_down[$id];
 232    $locks_down[$id] = 1;
 233   }
 234   {
 235    lock $locks_up[$id];
 236    $locks_up[$id] = 0;
 237   }
 238  }
 239
 240  my $thr1_end = 'finishes first';
 241  my $thr2_end = 'finishes last';
 242
 243  ($thr1_end, $thr2_end) = ($thr2_end, $thr1_end)
 244                                                 unless $first_thread_ends_first;
 245
 246  SKIP: {
 247   my $thr1 = spawn(sub {
 248    my $here = "first simultaneous thread ($thr1_end)";
 249    sync_slave 0;
 250
 251    is_loaded 0, "$here, beginning";
 252    sync_slave 1;
 253
 254    do_load;
 255    is_loaded 1, "$here, after loading";
 256    sync_slave 2;
 257    sync_slave 3;
 258
 259    sync_slave 4;
 260    is_loaded 1, "$here, still loaded while also loaded in the other thread";
 261    sync_slave 5;
 262
 263    sync_slave 6 unless $first_thread_ends_first;
 264
 265    is_loaded 1, "$here, end";
 266
 267    return;
 268   });
 269
 270   skip "$could_not_create_thread (parallel 1)" => (4 * 2) unless defined $thr1;
 271
 272   my $thr2 = spawn(sub {
 273    my $here = "second simultaneous thread ($thr2_end)";
 274    sync_slave 0;
 275
 276    is_loaded 0, "$here, beginning";
 277    sync_slave 1;
 278
 279    sync_slave 2;
 280    sync_slave 3;
 281    is_loaded 0, "$here, loaded in other thread but not here";
 282
 283    do_load;
 284    is_loaded 1, "$here, after loading";
 285    sync_slave 4;
 286    sync_slave 5;
 287
 288    sync_slave 6 if $first_thread_ends_first;
 289
 290    is_loaded 1, "$here, end";
 291
 292    return;
 293   });
 294
 295   sync_master($_) for 0 .. 5;
 296
 297   if (defined $thr2) {
 298    ($thr2, $thr1) = ($thr1, $thr2) unless $first_thread_ends_first;
 299
 300    $thr1->join;
 301    if (my $err = $thr1->error) {
 302     die $err;
 303    }
 304
 305    sync_master(6, 1);
 306
 307    $thr2->join;
 308    if (my $err = $thr1->error) {
 309     die $err;
 310    }
 311   } else {
 312    sync_master(6, 1) unless $first_thread_ends_first;
 313
 314    $thr1->join;
 315    if (my $err = $thr1->error) {
 316     die $err;
 317    }
 318
 319    skip "$could_not_create_thread (parallel 2)" => (4 * 1);
 320   }
 321  }
 322
 323  is_loaded 0, 'main body, after simultaneous threads';
 324 }
 325
 326 do_load;
 327 is_loaded 1, 'main body, loaded at end';