t/09-load-threads.t

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