t/11-detach.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) + 1;
  20
  21 BEGIN {
  22  defined and diag "Using threads $_"         for $threads::VERSION;
  23  defined and diag "Using threads::shared $_" for $threads::shared::VERSION;
  24 }
  25
  26 use Thread::Cleanup;
  27
  28 my %called : shared;
  29 my %nums   : shared;
  30
  31 our $x = -1;
  32
  33 Thread::Cleanup::register {
  34  my $tid = threads->tid;
  35  {
  36   lock %called;
  37   $called{$tid}++;
  38  }
  39
  40  my $num = do {
  41   lock %nums;
  42   $nums{$tid};
  43  };
  44
  45  is $x, $num, "\$x in destructor of thread $tid";
  46  local $x = $tid;
  47 };
  48
  49 my %ran : shared;
  50
  51 sub cb {
  52  my ($y) = @_;
  53
  54  my $tid = threads->tid;
  55  {
  56   lock %ran;
  57   $ran{$tid}++;
  58  }
  59
  60  {
  61   lock %nums;
  62   $nums{$tid} = $y;
  63  }
  64  is $x, $y, "\$x in thread $tid";
  65  local $x = -$tid;
  66
  67  sleep 1;
  68 }
  69
  70 my @tids;
  71
  72 my @t = map {
  73  local $x = $_;
  74  my $thr = threads->create(\&cb, $_);
  75  push @tids, $thr->tid;
  76  $thr;
  77 } 0 .. 4;
  78
  79 $_->detach for @t;
  80
  81 sleep 2;
  82
  83 is $x, -1, '$x in the main thread';
  84
  85 for (@tids) {
  86  is $ran{$_},    1,     "thread $_ was run once";
  87  is $called{$_}, undef, "thread $_ destructor wasn't called yet";
  88 }
  89
  90 END {
  91  is $called{$_}, 1, "thread $_ destructor was called once at END time"
  92                                                                       for @tids;
  93 }