Commit | Line | Data |
0f1612a7 |
1 | use strict; |
2 | use warnings; |
6794f985 |
3 | |
4 | BEGIN { |
0f1612a7 |
5 | if ($ENV{'PERL_CORE'}){ |
6 | chdir 't'; |
7 | unshift @INC, '../lib'; |
8 | } |
9 | use Config; |
6794f985 |
10 | unless ($Config{'useithreads'}) { |
11 | print "1..0 # Skip: no useithreads\n"; |
12 | exit 0; |
13 | } |
14 | } |
15 | |
16 | use ExtUtils::testlib; |
17 | |
6794f985 |
18 | |
19 | |
20 | BEGIN { $| = 1; print "1..8\n" }; |
74bf223e |
21 | use threads; |
6794f985 |
22 | |
23 | |
24 | |
74bf223e |
25 | print "ok 1\n"; |
6794f985 |
26 | |
27 | |
74bf223e |
28 | ######################### |
29 | sub ok { |
30 | my ($id, $ok, $name) = @_; |
6794f985 |
31 | |
74bf223e |
32 | # You have to do it this way or VMS will get confused. |
33 | print $ok ? "ok $id - $name\n" : "not ok $id - $name\n"; |
6794f985 |
34 | |
74bf223e |
35 | printf "# Failed test at line %d\n", (caller)[2] unless $ok; |
6794f985 |
36 | |
74bf223e |
37 | return $ok; |
38 | } |
6794f985 |
39 | |
a31a65c0 |
40 | ok(2, scalar @{[threads->list]} == 0,''); |
6794f985 |
41 | |
42 | |
6794f985 |
43 | |
74bf223e |
44 | threads->create(sub {})->join(); |
a31a65c0 |
45 | ok(3, scalar @{[threads->list]} == 0,''); |
74bf223e |
46 | |
47 | my $thread = threads->create(sub {}); |
a31a65c0 |
48 | ok(4, scalar @{[threads->list]} == 1,''); |
74bf223e |
49 | $thread->join(); |
a31a65c0 |
50 | ok(5, scalar @{[threads->list]} == 0,''); |
74bf223e |
51 | |
a31a65c0 |
52 | $thread = threads->create(sub { ok(6, threads->self == (threads->list)[0],'')}); |
da32f63e |
53 | threads->yield; # help out non-preemptive thread implementations |
74bf223e |
54 | sleep 1; |
a31a65c0 |
55 | ok(7, $thread == (threads->list)[0],''); |
74bf223e |
56 | $thread->join(); |
a31a65c0 |
57 | ok(8, scalar @{[threads->list]} == 0,''); |