t/09-load-threads.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
   7
   8 my ($module, $thread_safe_var);
   9 BEGIN {
  10  $module          = 'indirect';
  11  $thread_safe_var = 'indirect::I_THREADSAFE()';
  12 }
  13
  14 sub load_test {
  15  my $res;
  16  if (defined &indirect::msg) {
  17   local $@;
  18   eval 'BEGIN { indirect->unimport(":fatal") if defined &indirect::msg } return; my $x = new X;';
  19   $res = $@;
  20  }
  21  if (defined $res and $res =~ /^Indirect call of method/) {
  22   return 1;
  23  } elsif (not defined $res or $res eq '') {
  24   return 0;
  25  } else {
  26   return $res;
  27  }
  28 }
  29
  30 # Keep the rest of the file untouched
  31
  32 use lib 't/lib';
  33 use VPIT::TestHelpers threads => [ $module, $thread_safe_var ];
  34
  35 my $could_not_create_thread = 'Could not create thread';
  36
  37 use Test::Leaner tests => 1 + (2 + 2 * 2) + 6 + (2 * 4 + 1) * 2 + 1;
  38
  39 sub is_loaded {
  40  my ($affirmative, $desc) = @_;
  41
  42  my $res = load_test();
  43
  44  my $expected;
  45  if ($affirmative) {
  46   $expected = 1;
  47   $desc     = "$desc: module loaded";
  48  } else {
  49   $expected = 0;
  50   $desc     = "$desc: module not loaded";
  51  }
  52
  53  unless (is $res, $expected, $desc) {
  54   $res      = defined $res ? "'$res'" : 'undef';
  55   $expected = "'$expected'";
  56   diag("Test '$desc' failed: got $res, expected $expected");
  57  }
  58
  59  return;
  60 }
  61
  62 BEGIN {
  63  local $@;
  64  my $code = eval "sub { require $module }";
  65  die $@ if $@;
  66  *do_load = $code;
  67 }
  68
  69 is_loaded 0, 'main body, beginning';
  70
  71 # Test serial loadings
  72
  73 SKIP: {
  74  my $thr = spawn(sub {
  75   my $here = "first serial thread";
  76   is_loaded 0, "$here, beginning";
  77
  78   do_load;
  79   is_loaded 1, "$here, after loading";
  80
  81   return;
  82  });
  83
  84  skip "$could_not_create_thread (serial 1)" => 2 unless defined $thr;
  85
  86  $thr->join;
  87  if (my $err = $thr->error) {
  88   die $err;
  89  }
  90 }
  91
  92 is_loaded 0, 'main body, in between serial loadings';
  93
  94 SKIP: {
  95  my $thr = spawn(sub {
  96   my $here = "second 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 2)" => 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, after serial loadings';
 114
 115 # Test nested loadings
 116
 117 SKIP: {
 118  my $thr = spawn(sub {
 119   my $here = 'parent thread';
 120   is_loaded 0, "$here, beginning";
 121
 122   SKIP: {
 123    my $kid = spawn(sub {
 124     my $here = 'child thread';
 125     is_loaded 0, "$here, beginning";
 126
 127     do_load;
 128     is_loaded 1, "$here, after loading";
 129
 130     return;
 131    });
 132
 133    skip "$could_not_create_thread (nested child)" => 2 unless defined $kid;
 134
 135    $kid->join;
 136    if (my $err = $kid->error) {
 137     die "in child thread: $err\n";
 138    }
 139   }
 140
 141   is_loaded 0, "$here, after child terminated";
 142
 143   do_load;
 144   is_loaded 1, "$here, after loading";
 145
 146   return;
 147  });
 148
 149  skip "$could_not_create_thread (nested parent)" => (3 + 2) unless defined $thr;
 150
 151  $thr->join;
 152  if (my $err = $thr->error) {
 153   die $err;
 154  }
 155 }
 156
 157 is_loaded 0, 'main body, after nested loadings';
 158
 159 # Test parallel loadings
 160
 161 use threads;
 162 use threads::shared;
 163
 164 my $sync_points = 7;
 165
 166 my @locks_down = (1) x $sync_points;
 167 my @locks_up   = (0) x $sync_points;
 168 share($_) for @locks_down, @locks_up;
 169
 170 my $default_peers = 2;
 171
 172 sub sync_master {
 173  my ($id, $peers) = @_;
 174
 175  $peers = $default_peers unless defined $peers;
 176
 177  {
 178   lock $locks_down[$id];
 179   $locks_down[$id] = 0;
 180   cond_broadcast $locks_down[$id];
 181  }
 182
 183  {
 184   lock $locks_up[$id];
 185   cond_wait $locks_up[$id] until $locks_up[$id] == $peers;
 186  }
 187 }
 188
 189 sub sync_slave {
 190  my ($id) = @_;
 191
 192  {
 193   lock $locks_down[$id];
 194   cond_wait $locks_down[$id] until $locks_down[$id] == 0;
 195  }
 196
 197  {
 198   lock $locks_up[$id];
 199   $locks_up[$id]++;
 200   cond_signal $locks_up[$id];
 201  }
 202 }
 203
 204 for my $first_thread_ends_first (0, 1) {
 205  for my $id (0 .. $sync_points - 1) {
 206   {
 207    lock $locks_down[$id];
 208    $locks_down[$id] = 1;
 209   }
 210   {
 211    lock $locks_up[$id];
 212    $locks_up[$id] = 0;
 213   }
 214  }
 215
 216  my $thr1_end = 'finishes first';
 217  my $thr2_end = 'finishes last';
 218
 219  ($thr1_end, $thr2_end) = ($thr2_end, $thr1_end)
 220                                                 unless $first_thread_ends_first;
 221
 222  SKIP: {
 223   my $thr1 = spawn(sub {
 224    my $here = "first simultaneous thread ($thr1_end)";
 225    sync_slave 0;
 226
 227    is_loaded 0, "$here, beginning";
 228    sync_slave 1;
 229
 230    do_load;
 231    is_loaded 1, "$here, after loading";
 232    sync_slave 2;
 233    sync_slave 3;
 234
 235    sync_slave 4;
 236    is_loaded 1, "$here, still loaded while also loaded in the other thread";
 237    sync_slave 5;
 238
 239    sync_slave 6 unless $first_thread_ends_first;
 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 ($thr2_end)";
 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    sync_slave 6 if $first_thread_ends_first;
 265
 266    is_loaded 1, "$here, end";
 267
 268    return;
 269   });
 270
 271   sync_master($_) for 0 .. 5;
 272
 273   if (defined $thr2) {
 274    ($thr2, $thr1) = ($thr1, $thr2) unless $first_thread_ends_first;
 275
 276    $thr1->join;
 277    if (my $err = $thr1->error) {
 278     die $err;
 279    }
 280
 281    sync_master(6, 1);
 282
 283    $thr2->join;
 284    if (my $err = $thr1->error) {
 285     die $err;
 286    }
 287   } else {
 288    sync_master(6, 1) unless $first_thread_ends_first;
 289
 290    $thr1->join;
 291    if (my $err = $thr1->error) {
 292     die $err;
 293    }
 294
 295    skip "$could_not_create_thread (parallel 2)" => (4 * 1);
 296   }
 297  }
 298
 299  is_loaded 0, 'main body, after simultaneous threads';
 300 }
 301
 302 do_load;
 303 is_loaded 1, 'main body, loaded at end';