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