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