]> git.vpit.fr Git - perl/modules/Thread-Cleanup.git/blob - t/11-detach.t
Skip threads tests unless perl version is 5.13.4 or greater
[perl/modules/Thread-Cleanup.git] / t / 11-detach.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 use Thread::Cleanup;
12
13 my %called : shared;
14 my %nums   : shared;
15
16 our $x = -1;
17
18 Thread::Cleanup::register {
19  my $tid = threads->tid;
20  {
21   lock %called;
22   $called{$tid}++;
23  }
24
25  my $num = do {
26   lock %nums;
27   $nums{$tid};
28  };
29
30  is $x, $num, "\$x in destructor of thread $tid";
31  local $x = $tid;
32 };
33
34 my %ran : shared;
35
36 sub cb {
37  my ($y) = @_;
38
39  my $tid = threads->tid;
40  {
41   lock %ran;
42   $ran{$tid}++;
43  }
44
45  {
46   lock %nums;
47   $nums{$tid} = $y;
48  }
49  is $x, $y, "\$x in thread $tid";
50  local $x = -$tid;
51
52  sleep 1;
53 }
54
55 my @threads = map {
56  local $x = $_;
57  spawn(\&cb, $_);
58 } 0 .. 4;
59
60 my @tids = map $_->tid, @threads;
61
62 $_->detach for @threads;
63
64 sleep 2;
65
66 is $x, -1, '$x in the main thread';
67
68 for (@tids) {
69  is $ran{$_},    1,     "thread $_ was run once";
70  is $called{$_}, undef, "thread $_ destructor wasn't called yet";
71 }
72
73 END {
74  is $called{$_}, 1, "thread $_ destructor was called once at END time"
75                                                                       for @tids;
76 }