t/10-join.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Config qw/%Config/;
   7
   8 BEGIN {
   9  if (!$Config{useithreads}) {
  10   require Test::More;
  11   Test::More->import;
  12   plan(skip_all => 'This perl wasn\'t built to support threads');
  13  }
  14 }
  15
  16 use threads;
  17 use threads::shared;
  18
  19 use Test::More tests => 5 * (2 + 2) + 1;
  20
  21 use Thread::Cleanup;
  22
  23 diag "Using threads $threads::VERSION";
  24 diag "Using threads::shared $threads::shared::VERSION";
  25
  26 my %called : shared;
  27 my %nums   : shared;
  28
  29 our $x = -1;
  30
  31 Thread::Cleanup::register {
  32  my $tid = threads->tid;
  33
  34  {
  35   lock %called;
  36   $called{$tid}++;
  37  }
  38
  39  my $num = do {
  40   lock %nums;
  41   $nums{$tid};
  42  };
  43
  44  is $x, $num, "\$x in destructor of thread $tid";
  45  local $x = $tid;
  46 };
  47
  48 my %ran : shared;
  49
  50 sub cb {
  51  my ($y) = @_;
  52
  53  my $tid = threads->tid;
  54  {
  55   lock %ran;
  56   $ran{$tid}++;
  57  }
  58
  59  {
  60   lock %nums;
  61   $nums{$tid} = $y;
  62  }
  63  is $x, $y, "\$x in thread $tid";
  64  local $x = -$tid;
  65 }
  66
  67 my @tids;
  68
  69 my @t = map {
  70  local $x = $_;
  71  my $thr = threads->create(\&cb, $_);
  72  push @tids, $thr->tid;
  73  $thr;
  74 } 0 .. 4;
  75
  76 $_->join for @t;
  77
  78 is $x, -1, '$x in the main thread';
  79
  80 for (@tids) {
  81  is $ran{$_},    1, "thread $_ was run once";
  82  is $called{$_}, 1, "thread $_ destructor was called once";
  83 }