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) + 2;
  57
  58 sub is_loaded {
  59  my ($affirmative, $desc) = @_;
  60
  61  my $res = load_test();
  62
  63  if ($affirmative) {
  64   is $res, 1, "$desc: module loaded";
  65  } else {
  66   is $res, 0, "$desc: module not loaded";
  67  }
  68 }
  69
  70 BEGIN {
  71  local $@;
  72  my $code = eval "sub { require $module }";
  73  die $@ if $@;
  74  *do_load = $code;
  75 }
  76
  77 is_loaded 0, 'main body, beginning';
  78
  79 # Test serial loadings
  80
  81 SKIP: {
  82  my $thr = spawn(sub {
  83   my $here = "first serial thread";
  84   is_loaded 0, "$here, beginning";
  85
  86   do_load;
  87   is_loaded 1, "$here, after loading";
  88
  89   return;
  90  });
  91
  92  skip "$could_not_create_thread (serial 1)" => 2 unless defined $thr;
  93
  94  $thr->join;
  95  if (my $err = $thr->error) {
  96   die $err;
  97  }
  98 }
  99
 100 is_loaded 0, 'main body, in between serial loadings';
 101
 102 SKIP: {
 103  my $thr = spawn(sub {
 104   my $here = "second serial thread";
 105   is_loaded 0, "$here, beginning";
 106
 107   do_load;
 108   is_loaded 1, "$here, after loading";
 109
 110   return;
 111  });
 112
 113  skip "$could_not_create_thread (serial 2)" => 2 unless defined $thr;
 114
 115  $thr->join;
 116  if (my $err = $thr->error) {
 117   die $err;
 118  }
 119 }
 120
 121 is_loaded 0, 'main body, after serial loadings';
 122
 123 # Test nested loadings
 124
 125 SKIP: {
 126  my $thr = spawn(sub {
 127   my $here = 'parent thread';
 128   is_loaded 0, "$here, beginning";
 129
 130   SKIP: {
 131    my $kid = spawn(sub {
 132     my $here = 'child thread';
 133     is_loaded 0, "$here, beginning";
 134
 135     do_load;
 136     is_loaded 1, "$here, after loading";
 137
 138     return;
 139    });
 140
 141    skip "$could_not_create_thread (nested child)" => 2 unless defined $kid;
 142
 143    $kid->join;
 144    if (my $err = $kid->error) {
 145     die "in child thread: $err\n";
 146    }
 147   }
 148
 149   is_loaded 0, "$here, after child terminated";
 150
 151   do_load;
 152   is_loaded 1, "$here, after loading";
 153
 154   return;
 155  });
 156
 157  skip "$could_not_create_thread (nested parent)" => (3 + 2) unless defined $thr;
 158
 159  $thr->join;
 160  if (my $err = $thr->error) {
 161   die $err;
 162  }
 163 }
 164
 165 is_loaded 0, 'main body, after nested loadings';
 166
 167 # Test parallel loadings
 168
 169 use threads;
 170 use threads::shared;
 171
 172 my @locks = (1) x 5;
 173 share($_) for @locks;
 174
 175 sub sync_master {
 176  my ($id) = @_;
 177
 178  {
 179   lock $locks[$id];
 180   $locks[$id] = 0;
 181   cond_broadcast $locks[$id];
 182  }
 183 }
 184
 185 sub sync_slave {
 186  my ($id) = @_;
 187
 188  {
 189   lock $locks[$id];
 190   cond_wait $locks[$id] until $locks[$id] == 0;
 191  }
 192 }
 193
 194 SKIP: {
 195  my $thr1 = spawn(sub {
 196   my $here = 'first simultaneous thread';
 197   is_loaded 0, "$here, beginning";
 198   sync_slave 0;
 199
 200   do_load;
 201   is_loaded 1, "$here, after loading";
 202   sync_slave 1;
 203   sync_slave 2;
 204
 205   sync_slave 3;
 206   is_loaded 1, "$here, still loaded while also loaded in the other thread";
 207   sync_slave 4;
 208
 209   is_loaded 1, "$here, end";
 210
 211   return;
 212  });
 213
 214  skip "$could_not_create_thread (parallel 1)" => (4 * 2) unless defined $thr1;
 215
 216  my $thr2 = spawn(sub {
 217   my $here = 'second simultaneous thread';
 218   is_loaded 0, "$here, beginning";
 219   sync_slave 0;
 220
 221   sync_slave 1;
 222   is_loaded 0, "$here, loaded in other thread but not here";
 223   sync_slave 2;
 224
 225   do_load;
 226   is_loaded 1, "$here, after loading";
 227   sync_slave 3;
 228   sync_slave 4;
 229
 230   is_loaded 1, "$here, end";
 231
 232   return;
 233  });
 234
 235  sync_master($_) for 0 .. $#locks;
 236
 237  $thr1->join;
 238  if (my $err = $thr1->error) {
 239   die $err;
 240  }
 241
 242  skip "$could_not_create_thread (parallel 2)" => (4 * 1) unless defined $thr2;
 243
 244  $thr2->join;
 245  if (my $err = $thr2->error) {
 246   die $err;
 247  }
 248 }
 249
 250 is_loaded 0, 'main body, after simultaneous threads';
 251
 252 do_load;
 253 is_loaded 1, 'main body, loaded at end';