t/40-threads.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use threads; # Before Test::More
   7 use threads::shared;
   8
   9 use Test::More;
  10
  11 use Variable::Magic qw/wizard cast dispell getdata VMG_THREADSAFE/;
  12
  13 if (VMG_THREADSAFE) {
  14  plan tests => 2 * 16 + 1;
  15 } else {
  16  plan skip_all => 'This Variable::Magic isn\'t thread safe';
  17 }
  18
  19 my $destroyed : shared = 0;
  20
  21 sub try {
  22  my $tid = threads->tid();
  23  my $c   = 0;
  24  my $wiz = eval {
  25   wizard get  => sub { ++$c },
  26          data => sub { $_[1] + $tid },
  27          free => sub { ++$destroyed };
  28  };
  29  is($@,     '',    "wizard in thread $tid doesn't croak");
  30  isnt($wiz, undef, "wizard in thread $tid is defined");
  31  is($c,     0,     "wizard in thread $tid doesn't trigger magic");
  32  my $a = 3;
  33  my $res = eval { cast $a, $wiz, sub { 5 }->() };
  34  is($@, '', "cast in thread $tid doesn't croak");
  35  is($c, 0,  "cast in thread $tid doesn't trigger magic");
  36  my $b;
  37  eval { $b = $a };
  38  is($@, '', "get in thread $tid doesn't croak");
  39  is($b, 3,  "get in thread $tid returns the right thing");
  40  is($c, 1,  "get in thread $tid triggers magic");
  41  my $d = eval { getdata $a, $wiz };
  42  is($@, '',       "getdata in thread $tid doesn't croak");
  43  is($d, 5 + $tid, "getdata in thread $tid returns the right thing");
  44  is($c, 1,        "getdata in thread $tid doesn't trigger magic");
  45  $res = eval { dispell $a, $wiz };
  46  is($@, '', "dispell in thread $tid doesn't croak");
  47  is($c, 1,  "dispell in thread $tid doesn't trigger magic");
  48  undef $b;
  49  eval { $b = $a };
  50  is($@, '', "get in thread $tid after dispell doesn't croak");
  51  is($b, 3,  "get in thread $tid after dispell returns the right thing");
  52  is($c, 1,  "get in thread $tid after dispell doesn't trigger magic");
  53  return;
  54 }
  55
  56 my @t = map { threads->create(\&try) } 1 .. 2;
  57 $t[0]->join;
  58 $t[1]->join;
  59
  60 is($destroyed, 0, 'destructors didn\'t fired');