This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Continuing threads sync
[perl5.git] / ext / threads / t / free.t
1 use strict;
2 use warnings;
3
4 BEGIN {
5     if ($ENV{'PERL_CORE'}){
6         chdir 't';
7         unshift @INC, '../lib';
8     }
9     use Config;
10     if (! $Config{'useithreads'}) {
11         print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
12         exit(0);
13     }
14 }
15
16 use ExtUtils::testlib;
17
18 use threads;
19 use threads::shared;
20
21 BEGIN {
22     $| = 1;
23     print("1..29\n");   ### Number of tests that will be run ###
24 };
25
26 my $TEST = 1;
27 share($TEST);
28
29 ok(1, 'Loaded');
30
31 sub ok {
32     my ($ok, $name) = @_;
33
34     lock($TEST);
35     my $id = $TEST++;
36
37     # You have to do it this way or VMS will get confused.
38     if ($ok) {
39         print("ok $id - $name\n");
40     } else {
41         print("not ok $id - $name\n");
42         printf("# Failed test at line %d\n", (caller)[2]);
43     }
44
45     return ($ok);
46 }
47
48
49 ### Start of Testing ###
50
51 # Tests freeing the Perl interperter for each thread
52 # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
53
54 my $COUNT;
55 share($COUNT);
56
57 sub threading_1 {
58     my $tid = threads->tid();
59     ok($tid, "Thread $tid started");
60
61     if ($tid < 5) {
62         sleep(1);
63         threads->create('threading_1')->detach();
64     }
65
66     threads->yield();
67
68     if ($tid == 1) {
69         sleep(2);
70     } elsif ($tid == 2) {
71         sleep(6);
72     } elsif ($tid == 3) {
73         sleep(3);
74     } elsif ($tid == 4) {
75         sleep(1);
76     } else {
77         sleep(2);
78     }
79
80     lock($COUNT);
81     $COUNT++;
82     cond_signal($COUNT);
83     ok($tid, "Thread $tid done");
84 }
85
86 {
87     $COUNT = 0;
88     threads->create('threading_1')->detach();
89     {
90         lock($COUNT);
91         while ($COUNT < 3) {
92             cond_wait($COUNT);
93         }
94     }
95 }
96 {
97     {
98         lock($COUNT);
99         while ($COUNT < 5) {
100             cond_wait($COUNT);
101         }
102     }
103     threads->yield();
104     sleep(1);
105 }
106 ok($COUNT == 5, "Done - $COUNT threads");
107
108
109 sub threading_2 {
110     my $tid = threads->tid();
111     ok($tid, "Thread $tid started");
112
113     if ($tid < 10) {
114         threads->create('threading_2')->detach();
115     }
116
117     threads->yield();
118
119     lock($COUNT);
120     $COUNT++;
121     cond_signal($COUNT);
122
123     ok($tid, "Thread $tid done");
124 }
125
126 {
127     $COUNT = 0;
128     threads->create('threading_2')->detach();
129     {
130         lock($COUNT);
131         while ($COUNT < 3) {
132             cond_wait($COUNT);
133         }
134     }
135     threads->yield();
136     sleep(1);
137 }
138 ok($COUNT == 5, "Done - $COUNT threads");
139
140
141 {
142     threads->create(sub { })->join();
143 }
144 ok(1, 'Join');
145
146
147 sub threading_3 {
148     my $tid = threads->tid();
149     ok($tid, "Thread $tid started");
150
151     {
152         threads->create(sub {
153             my $tid = threads->tid();
154             ok($tid, "Thread $tid started");
155
156             threads->yield();
157             sleep(1);
158
159             lock($COUNT);
160             $COUNT++;
161             cond_signal($COUNT);
162
163             ok($tid, "Thread $tid done");
164         })->join();
165     }
166
167     lock($COUNT);
168     $COUNT++;
169     cond_signal($COUNT);
170
171     ok($tid, "Thread $tid done");
172 }
173
174 {
175     $COUNT = 0;
176     threads->create(sub {
177         threads->create('threading_3')->detach();
178         {
179             lock($COUNT);
180             while ($COUNT < 2) {
181                 cond_wait($COUNT);
182             }
183         }
184     })->join();
185     threads->yield();
186     sleep(1);
187 }
188 ok($COUNT == 2, "Done - $COUNT threads");
189
190 # EOF