This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Merge branch 'vlb' into blead
[perl5.git] / lib / Thread.t
CommitLineData
9d40afd1
JH
1use strict;
2use warnings;
3
4BEGIN {
5 chdir 't' if -d 't';
6 @INC = '../lib';
7
8 use Config;
9 if (! $Config{usethreads}) {
10 print("1..0 # Skip: No threads\n");
11 exit(0);
12 }
13}
14
15use Thread qw(:DEFAULT async yield);
16
17use Test::More tests => 13;
18
19my $lock;
20{
21 no warnings 'once';
22 if ($threads::shared::threads_shared) {
23 &threads::shared::share(\$lock);
24 }
25}
26
27
28BASIC:
29{
30 sub thr_sub
31 {
32 lock($lock);
33 my $self = Thread->self;
34 return $self->tid;
35 }
36
37 my $thr;
38 {
39 lock($lock);
40
41 $thr = Thread->new(\&thr_sub);
42
43 isa_ok($thr, 'Thread');
44
45 ok(! $thr->done(), 'Thread running');
46 is($thr->tid, 1, "thread's tid");
47
48 my ($thr2) = Thread->list;
49 ok($thr2->equal($thr), '->list returned thread');
50 }
51 yield();
52 sleep(1);
53
54 ok($thr->done(), 'Thread done');
55 is($thr->join(), 1, "->join returned thread's tid");
56}
57
58ASYNC:
59{
60 my $thr = async { Thread->self->tid; };
61 isa_ok($thr, 'Thread');
62 is($thr->tid, 2, "async thread's tid");
63 is($thr->join, 2, "->join on async returned tid");
64}
65
66COND_:
67{
68 sub thr_wait
69 {
70 lock($lock);
71 cond_wait($lock);
72 return Thread->self->tid;
73 }
74
40c87247
JH
75 my $thr;
76 {
77 lock($lock);
78 $thr = Thread->new(\&thr_wait);
79 isa_ok($thr, 'Thread');
80 ok(! $thr->done(), 'Thread running');
81 }
82 yield();
83 sleep(1);
9d40afd1
JH
84
85 {
86 lock($lock);
87 cond_signal($lock);
88 }
89 yield();
90 sleep(1);
91
92 ok($thr->done(), 'Thread done');
93 is($thr->join(), 3, "->join returned thread's tid");
94}
95
96# EOF