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