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