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  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 @locks_down = (1) x 6;
 189 my @locks_up   = (0) x scalar @locks_down;
 190 share($_) for @locks_down, @locks_up;
 191
 192 my $peers = 2;
 193
 194 sub sync_master {
 195  my ($id) = @_;
 196
 197  {
 198   lock $locks_down[$id];
 199   $locks_down[$id] = 0;
 200   cond_broadcast $locks_down[$id];
 201  }
 202
 203  {
 204   lock $locks_up[$id];
 205   cond_wait $locks_up[$id] until $locks_up[$id] == $peers;
 206  }
 207 }
 208
 209 sub sync_slave {
 210  my ($id) = @_;
 211
 212  {
 213   lock $locks_down[$id];
 214   cond_wait $locks_down[$id] until $locks_down[$id] == 0;
 215  }
 216
 217  {
 218   lock $locks_up[$id];
 219   $locks_up[$id]++;
 220   cond_signal $locks_up[$id];
 221  }
 222 }
 223
 224 SKIP: {
 225  my $thr1 = spawn(sub {
 226   my $here = 'first simultaneous thread';
 227   sync_slave 0;
 228
 229   is_loaded 0, "$here, beginning";
 230   sync_slave 1;
 231
 232   do_load;
 233   is_loaded 1, "$here, after loading";
 234   sync_slave 2;
 235   sync_slave 3;
 236
 237   sync_slave 4;
 238   is_loaded 1, "$here, still loaded while also loaded in the other thread";
 239   sync_slave 5;
 240
 241   is_loaded 1, "$here, end";
 242
 243   return;
 244  });
 245
 246  skip "$could_not_create_thread (parallel 1)" => (4 * 2) unless defined $thr1;
 247
 248  my $thr2 = spawn(sub {
 249   my $here = 'second simultaneous thread';
 250   sync_slave 0;
 251
 252   is_loaded 0, "$here, beginning";
 253   sync_slave 1;
 254
 255   sync_slave 2;
 256   sync_slave 3;
 257   is_loaded 0, "$here, loaded in other thread but not here";
 258
 259   do_load;
 260   is_loaded 1, "$here, after loading";
 261   sync_slave 4;
 262   sync_slave 5;
 263
 264   is_loaded 1, "$here, end";
 265
 266   return;
 267  });
 268
 269  sync_master($_) for 0 .. $#locks_down;
 270
 271  $thr1->join;
 272  if (my $err = $thr1->error) {
 273   die $err;
 274  }
 275
 276  skip "$could_not_create_thread (parallel 2)" => (4 * 1) unless defined $thr2;
 277
 278  $thr2->join;
 279  if (my $err = $thr2->error) {
 280   die $err;
 281  }
 282 }
 283
 284 is_loaded 0, 'main body, after simultaneous threads';
 285
 286 do_load;
 287 is_loaded 1, 'main body, loaded at end';