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
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
20 BEGIN {
21     eval {
22         require threads::shared;
23         threads::shared->import();
24     };
25     if ($@ || ! $threads::shared::threads_shared) {
26         print("1..0 # Skip: threads::shared not available\n");
27         exit(0);
28     }
29
30     require Thread::Queue;
31
32     $| = 1;
33     print("1..29\n");   ### Number of tests that will be run ###
34 }
35
36
37 my $q = Thread::Queue->new();
38 my $TEST = 1;
39
40 sub 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         }
55     }
56 }
57
58
59 ### Start of Testing ###
60 ok(1, 'Loaded');
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
65 my ($COUNT, $STARTED) :shared;
66
67 sub threading_1 {
68     my $q = shift;
69
70     my $tid = threads->tid();
71     $q->enqueue($tid, "Thread $tid started");
72
73     my $id;
74     {
75         lock($STARTED);
76         $STARTED++;
77         $id = $STARTED;
78     }
79     if ($STARTED < 5) {
80         sleep(1);
81         threads->create('threading_1', $q)->detach();
82     }
83
84     if ($id == 1) {
85         sleep(2);
86     } elsif ($id == 2) {
87         sleep(6);
88     } elsif ($id == 3) {
89         sleep(3);
90     } elsif ($id == 4) {
91         sleep(1);
92     } else {
93         sleep(2);
94     }
95
96     lock($COUNT);
97     $COUNT++;
98     cond_signal($COUNT);
99     $q->enqueue($tid, "Thread $tid done");
100 }
101
102 {
103     $STARTED = 0;
104     $COUNT = 0;
105     threads->create('threading_1', $q)->detach();
106     {
107         my $cnt = 0;
108         while ($cnt < 5) {
109             {
110                 lock($COUNT);
111                 cond_wait($COUNT) if ($COUNT < 5);
112                 $cnt = $COUNT;
113             }
114             threads->create(sub {
115                 threads->create(sub { })->join();
116             })->join();
117         }
118     }
119     sleep(1);
120 }
121 ok($COUNT == 5, "Done - $COUNT threads");
122
123
124 sub threading_2 {
125     my $q = shift;
126
127     my $tid = threads->tid();
128     $q->enqueue($tid, "Thread $tid started");
129
130     {
131         lock($STARTED);
132         $STARTED++;
133     }
134     if ($STARTED < 5) {
135         threads->create('threading_2', $q)->detach();
136     }
137     threads->yield();
138
139     lock($COUNT);
140     $COUNT++;
141     cond_signal($COUNT);
142
143     $q->enqueue($tid, "Thread $tid done");
144 }
145
146 {
147     $STARTED = 0;
148     $COUNT = 0;
149     threads->create('threading_2', $q)->detach();
150     threads->create(sub {
151         threads->create(sub { })->join();
152     })->join();
153     {
154         lock($COUNT);
155         while ($COUNT < 5) {
156             cond_wait($COUNT);
157         }
158     }
159     sleep(1);
160 }
161 ok($COUNT == 5, "Done - $COUNT threads");
162
163
164 {
165     threads->create(sub { })->join();
166 }
167 ok(1, 'Join');
168
169
170 sub threading_3 {
171     my $q = shift;
172
173     my $tid = threads->tid();
174     $q->enqueue($tid, "Thread $tid started");
175
176     {
177         threads->create(sub {
178             my $q = shift;
179
180             my $tid = threads->tid();
181             $q->enqueue($tid, "Thread $tid started");
182
183             sleep(1);
184
185             lock($COUNT);
186             $COUNT++;
187             cond_signal($COUNT);
188
189             $q->enqueue($tid, "Thread $tid done");
190         }, $q)->detach();
191     }
192
193     lock($COUNT);
194     $COUNT++;
195     cond_signal($COUNT);
196
197     $q->enqueue($tid, "Thread $tid done");
198 }
199
200 {
201     $COUNT = 0;
202     threads->create(sub {
203         threads->create('threading_3', $q)->detach();
204         {
205             lock($COUNT);
206             while ($COUNT < 2) {
207                 cond_wait($COUNT);
208             }
209         }
210     })->join();
211     sleep(1);
212 }
213 ok($COUNT == 2, "Done - $COUNT threads");
214
215 # EOF