]> git.vpit.fr Git - perl/modules/Thread-Cleanup.git/blob - t/20-recurse.t
Don't exit() when dieing during cleanup
[perl/modules/Thread-Cleanup.git] / t / 20-recurse.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 my ($num, $depth);
20 BEGIN {
21  $num   = 3;
22  $depth = 2;
23 }
24
25 use Test::More tests => (($num ** ($depth + 1) - 1) / ($num - 1) - 1 ) * (2 + 2) + 1;
26
27 BEGIN {
28  defined and diag "Using threads $_"         for $threads::VERSION;
29  defined and diag "Using threads::shared $_" for $threads::shared::VERSION;
30 }
31
32 use Thread::Cleanup;
33
34 diag 'This will leak some scalars';
35
36 our $x = -1;
37
38 my %ran    : shared;
39 my %nums   : shared;
40 my %called : shared;
41
42 my @tids;
43
44 sub spawn {
45  my ($num, $depth) = @_;
46  @tids = ();
47  return unless $depth > 0;
48  map {
49   local $x = $_;
50   my $thr = threads->create(\&cb, $_, $depth);
51   push @tids, $thr->tid;
52   $thr;
53  } 1 .. $num;
54 }
55
56 sub check {
57  lock %ran;
58  lock %called;
59  for (@tids) {
60   is $ran{$_},    1, "thread $_ was run once";
61   is $called{$_}, 1, "thread $_ destructor was called once";
62  }
63 }
64
65 sub cb {
66  my ($y, $depth) = @_;
67
68  my $tid = threads->tid;
69  {
70   lock %ran;
71   $ran{$tid}++;
72  }
73
74  {
75   lock %nums;
76   $nums{$tid} = $y;
77  }
78  is $x, $y, "\$x in thread $tid";
79  local $x = -$tid;
80
81  $_->join for spawn $num, $depth - 1;
82
83  check;
84 }
85
86 Thread::Cleanup::register {
87  my $tid = threads->tid;
88  {
89   lock %called;
90   $called{$tid}++;
91  }
92
93  my $num = do {
94   lock %nums;
95   $nums{$tid};
96  };
97
98  is $x, $num, "\$x in destructor of thread $tid";
99  local $x = $tid;
100 };
101
102 $_->join for spawn $num, $depth;
103
104 check;
105
106 is $x, -1, '$x in the main thread';
107