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