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 my %called : shared;
  24 my %nums   : shared;
  25
  26 our $x = -1;
  27
  28 Thread::Cleanup::register {
  29  my $tid = threads->tid;
  30  {
  31   lock %called;
  32   $called{$tid}++;
  33  }
  34
  35  my $num = do {
  36   lock %nums;
  37   $nums{$tid};
  38  };
  39
  40  is $x, $num, "\$x in destructor of thread $tid";
  41  local $x = $tid;
  42 };
  43
  44 my %ran : shared;
  45
  46 sub cb {
  47  my ($y) = @_;
  48
  49  my $tid = threads->tid;
  50  {
  51   lock %ran;
  52   $ran{$tid}++;
  53  }
  54
  55  {
  56   lock %nums;
  57   $nums{$tid} = $y;
  58  }
  59  is $x, $y, "\$x in thread $tid";
  60  local $x = -$tid;
  61
  62  sleep 1;
  63 }
  64
  65 my @tids;
  66
  67 my @t = map {
  68  local $x = $_;
  69  my $thr = threads->create(\&cb, $_);
  70  push @tids, $thr->tid;
  71  $thr;
  72 } 0 .. 4;
  73
  74 diag "Using threads $threads::VERSION";
  75 diag "Using threads::shared $threads::shared::VERSION";
  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 }