This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
threads 1.64 (repost)
[perl5.git] / ext / threads / t / free.t
CommitLineData
385d56e4
JH
1use strict;
2use warnings;
3
4BEGIN {
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
16use ExtUtils::testlib;
17
9feacc09 18use threads;
9feacc09
JH
19
20BEGIN {
58a3a76c
JH
21 eval {
22 require threads::shared;
f3086ff0 23 threads::shared->import();
58a3a76c
JH
24 };
25 if ($@ || ! $threads::shared::threads_shared) {
26 print("1..0 # Skip: threads::shared not available\n");
27 exit(0);
28 }
29
18b9e6f5
JH
30 require Thread::Queue;
31
9feacc09
JH
32 $| = 1;
33 print("1..29\n"); ### Number of tests that will be run ###
4dcb9e53 34}
9feacc09 35
9feacc09 36
18b9e6f5
JH
37my $q = Thread::Queue->new();
38my $TEST = 1;
9feacc09 39
18b9e6f5
JH
40sub ok
41{
42 $q->enqueue(@_);
43
44 while ($q->pending()) {
45 my $ok = $q->dequeue();
46 my $name = $q->dequeue();
47 my $id = $TEST++;
48
49 if ($ok) {
50 print("ok $id - $name\n");
51 } else {
52 print("not ok $id - $name\n");
53 printf("# Failed test at line %d\n", (caller)[2]);
54 }
385d56e4 55 }
385d56e4
JH
56}
57
385d56e4
JH
58
59### Start of Testing ###
18b9e6f5 60ok(1, 'Loaded');
385d56e4
JH
61
62# Tests freeing the Perl interperter for each thread
63# See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
64
f782ee33 65my ($COUNT, $STARTED) :shared;
385d56e4
JH
66
67sub threading_1 {
18b9e6f5
JH
68 my $q = shift;
69
385d56e4 70 my $tid = threads->tid();
18b9e6f5 71 $q->enqueue($tid, "Thread $tid started");
385d56e4 72
d4315dd6 73 my $id;
f782ee33
JH
74 {
75 lock($STARTED);
76 $STARTED++;
d4315dd6 77 $id = $STARTED;
f782ee33
JH
78 }
79 if ($STARTED < 5) {
385d56e4 80 sleep(1);
18b9e6f5 81 threads->create('threading_1', $q)->detach();
385d56e4
JH
82 }
83
d4315dd6 84 if ($id == 1) {
385d56e4 85 sleep(2);
d4315dd6 86 } elsif ($id == 2) {
385d56e4 87 sleep(6);
d4315dd6 88 } elsif ($id == 3) {
385d56e4 89 sleep(3);
d4315dd6 90 } elsif ($id == 4) {
385d56e4
JH
91 sleep(1);
92 } else {
93 sleep(2);
94 }
95
96 lock($COUNT);
97 $COUNT++;
98 cond_signal($COUNT);
18b9e6f5 99 $q->enqueue($tid, "Thread $tid done");
385d56e4
JH
100}
101
102{
f782ee33 103 $STARTED = 0;
385d56e4 104 $COUNT = 0;
18b9e6f5 105 threads->create('threading_1', $q)->detach();
385d56e4 106 {
d4315dd6
JH
107 my $cnt = 0;
108 while ($cnt < 5) {
109 {
110 lock($COUNT);
111 cond_wait($COUNT) if ($COUNT < 5);
112 $cnt = $COUNT;
113 }
f782ee33
JH
114 threads->create(sub {
115 threads->create(sub { })->join();
116 })->join();
385d56e4
JH
117 }
118 }
385d56e4
JH
119 sleep(1);
120}
9feacc09 121ok($COUNT == 5, "Done - $COUNT threads");
385d56e4
JH
122
123
124sub threading_2 {
18b9e6f5
JH
125 my $q = shift;
126
385d56e4 127 my $tid = threads->tid();
18b9e6f5 128 $q->enqueue($tid, "Thread $tid started");
385d56e4 129
f782ee33
JH
130 {
131 lock($STARTED);
132 $STARTED++;
133 }
134 if ($STARTED < 5) {
18b9e6f5 135 threads->create('threading_2', $q)->detach();
385d56e4 136 }
385d56e4
JH
137 threads->yield();
138
139 lock($COUNT);
140 $COUNT++;
141 cond_signal($COUNT);
142
18b9e6f5 143 $q->enqueue($tid, "Thread $tid done");
385d56e4
JH
144}
145
146{
f782ee33 147 $STARTED = 0;
385d56e4 148 $COUNT = 0;
18b9e6f5 149 threads->create('threading_2', $q)->detach();
f782ee33
JH
150 threads->create(sub {
151 threads->create(sub { })->join();
152 })->join();
385d56e4
JH
153 {
154 lock($COUNT);
f782ee33 155 while ($COUNT < 5) {
385d56e4
JH
156 cond_wait($COUNT);
157 }
158 }
385d56e4
JH
159 sleep(1);
160}
9feacc09 161ok($COUNT == 5, "Done - $COUNT threads");
385d56e4
JH
162
163
164{
165 threads->create(sub { })->join();
166}
9feacc09 167ok(1, 'Join');
385d56e4
JH
168
169
170sub threading_3 {
18b9e6f5
JH
171 my $q = shift;
172
385d56e4 173 my $tid = threads->tid();
18b9e6f5 174 $q->enqueue($tid, "Thread $tid started");
385d56e4
JH
175
176 {
177 threads->create(sub {
18b9e6f5
JH
178 my $q = shift;
179
385d56e4 180 my $tid = threads->tid();
18b9e6f5 181 $q->enqueue($tid, "Thread $tid started");
385d56e4 182
385d56e4
JH
183 sleep(1);
184
185 lock($COUNT);
186 $COUNT++;
187 cond_signal($COUNT);
188
18b9e6f5
JH
189 $q->enqueue($tid, "Thread $tid done");
190 }, $q)->detach();
385d56e4
JH
191 }
192
193 lock($COUNT);
194 $COUNT++;
195 cond_signal($COUNT);
196
18b9e6f5 197 $q->enqueue($tid, "Thread $tid done");
385d56e4
JH
198}
199
200{
201 $COUNT = 0;
202 threads->create(sub {
18b9e6f5 203 threads->create('threading_3', $q)->detach();
385d56e4
JH
204 {
205 lock($COUNT);
206 while ($COUNT < 2) {
207 cond_wait($COUNT);
208 }
209 }
210 })->join();
385d56e4
JH
211 sleep(1);
212}
9feacc09 213ok($COUNT == 2, "Done - $COUNT threads");
385d56e4
JH
214
215# EOF