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