1use strict;
2use warnings;
3
4BEGIN {
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
17use ExtUtils::testlib;
18
19use threads;
20
21BEGIN {
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
32Test::watchdog(120);   # In case we get stuck
33
34my $q = Thread::Queue->new();
35my $TEST = 1;
36
37sub 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 ###
57ok(1, 'Loaded');
58
59# Tests freeing the Perl interpreter for each thread
60# See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
61
62my ($COUNT, $STARTED) :shared;
63
64sub 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}
118ok($COUNT == 5, "Done - $COUNT threads");
119
120
121sub 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}
158ok($COUNT == 5, "Done - $COUNT threads");
159
160
161{
162    threads->create(sub { })->join();
163}
164ok(1, 'Join');
165
166
167sub 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}
210ok($COUNT == 2, "Done - $COUNT threads");
211
212exit(0);
213
214# EOF
215