t/20-recurse.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use lib 't/lib';
   7 use Thread::Cleanup::TestThreads;
   8
   9 use Test::More 'no_plan';
  10
  11 my $num   = 3;
  12 my $depth = 2;
  13
  14 use Thread::Cleanup;
  15
  16 diag 'This will leak some scalars' unless "$]" >= 5.011_005;
  17
  18 our $x = -1;
  19
  20 my %ran    : shared;
  21 my %nums   : shared;
  22 my %called : shared;
  23
  24 my @tids;
  25
  26 sub test_threads {
  27  my ($num, $depth) = @_;
  28  if ($depth <= 0) {
  29   @tids = ();
  30   return;
  31  }
  32  my @threads = map {
  33   local $x = $_;
  34   spawn(\&cb, $_, $depth);
  35  } 1 .. $num;
  36  @tids = map $_->tid, @threads;
  37  return @threads;
  38 }
  39
  40 sub check {
  41  lock %ran;
  42  lock %called;
  43  for (@tids) {
  44   is $ran{$_},    1, "thread $_ was run once";
  45   is $called{$_}, 1, "thread $_ destructor was called once";
  46  }
  47 }
  48
  49 sub cb {
  50  my ($y, $depth) = @_;
  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  $_->join for test_threads $num, $depth - 1;
  66
  67  check;
  68 }
  69
  70 Thread::Cleanup::register {
  71  my $tid = threads->tid;
  72  {
  73   lock %called;
  74   $called{$tid}++;
  75  }
  76
  77  my $num = do {
  78   lock %nums;
  79   $nums{$tid};
  80  };
  81
  82  is $x, $num, "\$x in destructor of thread $tid";
  83  local $x = $tid;
  84 };
  85
  86 $_->join for test_threads $num, $depth;
  87
  88 check;
  89
  90 is $x, -1, '$x in the main thread';
  91