1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
plan(24);
# 2 tests
{
my $ran := 0;
my $t := nqp::newthread({ $ran := 1 }, 0);
ok(nqp::defined($t), 'Can create a new non-app-lifetime thread');
nqp::threadrun($t);
nqp::threadjoin($t);
ok($ran, 'Can run and join the new thread');
}
# 2 tests
{
my $start := nqp::time();
my $t := nqp::newthread({ nqp::sleep(10.0) }, 1);
ok(nqp::defined($t), 'Can create a new app-lifetime thread');
nqp::threadrun($t);
ok(nqp::islt_i(nqp::sub_i(nqp::time(), $start), 10*1000000000),
'Sleeping app-lifetime thread does not block main thread');
}
# 4 tests
{
my int $done := 0;
my $t := nqp::newthread({
1 until $done;
ok(1, 'Can write to STDOUT in child thread');
}, 0);
ok(1, 'Can write to STDOUT in parent thread before threadrun');
nqp::threadrun($t);
ok(1, 'Can write to STDOUT in parent thread after threadrun');
$done := 1;
nqp::threadjoin($t);
ok(1, 'Can write to STDOUT in parent thread after threadjoin');
}
# 9 tests
{
my $c := nqp::currentthread();
my $pid := nqp::threadid($c);
ok($pid, 'Parent thread has a non-zero ID');
my $tid := 0;
my $cid := 0;
my $t := nqp::newthread({
$cid := nqp::threadid(nqp::currentthread());
}, 0);
ok(nqp::defined($t), 'Can create another new thread after previous joins');
$tid := nqp::threadid($t);
ok($tid, 'New thread has a non-zero ID');
ok($tid != $pid, 'Parent and new thread have different IDs');
nqp::threadrun($t);
ok($tid == nqp::threadid($t), 'Thread keeps same ID after threadrun()');
nqp::threadjoin($t);
ok($tid == nqp::threadid($t), 'Thread keeps same ID after threadjoin()');
ok($cid, 'Child thread knew its own thread ID');
ok($cid == $tid, 'Parent saw same ID for child as child did');
ok($pid == nqp::threadid(nqp::currentthread()),
'Parent thread still has the same ID');
}
# 3 tests
{
my $a := 0;
my $b := 0;
my $t1 := nqp::newthread({ $a := 21 }, 0);
my $t2 := nqp::newthread({ $b := 42 }, 0);
nqp::threadrun($t1);
nqp::threadrun($t2);
ok(nqp::threadid($t1) != nqp::threadid($t2),
'Two new child threads have different IDs');
nqp::threadjoin($t1);
nqp::threadjoin($t2);
ok($a == 21, 'First child thread actually ran');
ok($b == 42, 'Second child thread also ran');
}
# 2 tests
# Parent-child case for threadyield()
# This test intentionally does not use proper synchronization primitives,
# so that threadyield can be tested independently of locks/condvars/etc.
{
my @a;
my $t := nqp::newthread({
nqp::threadyield() until nqp::elems(@a) == 1 && @a[0] eq 'a';
nqp::push(@a, '1');
nqp::threadyield() until nqp::elems(@a) == 3 && @a[2] eq 'b';
nqp::push(@a, '2');
}, 0);
# Make sure child thread is at least *runnable* (if not actually running)
# before running parent thread's code.
nqp::threadrun($t);
{
nqp::push(@a, 'a');
nqp::threadyield() until nqp::elems(@a) == 2 && @a[1] eq '1';
nqp::push(@a, 'b');
nqp::threadyield() until nqp::elems(@a) == 4 && @a[3] eq '2';
nqp::push(@a, 'c');
}
nqp::threadjoin($t);
ok(@a[0] eq 'a',
'Looped threadyield() can force parent thread to act first');
my $order := nqp::join(',', @a);
my $ok := $order eq 'a,1,b,2,c';
ok($ok, 'threadyield() properly interleaved parent and child threads');
say("# execution order = $order (expected a,1,b,2,c)") if !$ok;
}
# 2 tests
# Sibling child threads case for threadyield()
# This test intentionally does not use proper synchronization primitives,
# so that threadyield can be tested independently of locks/condvars/etc.
{
my @a;
my $t1 := nqp::newthread({
nqp::push(@a, 'a');
nqp::threadyield() until nqp::elems(@a) == 2 && @a[1] eq '1';
nqp::push(@a, 'b');
nqp::threadyield() until nqp::elems(@a) == 4 && @a[3] eq '2';
nqp::push(@a, 'c');
}, 0);
my $t2 := nqp::newthread({
nqp::threadyield() until nqp::elems(@a) == 1 && @a[0] eq 'a';
nqp::push(@a, '1');
nqp::threadyield() until nqp::elems(@a) == 3 && @a[2] eq 'b';
nqp::push(@a, '2');
}, 0);
# Make sure $t2 is at least *runnable* (if not actually running)
# before $t1 becomes runnable.
nqp::threadrun($t2);
nqp::threadrun($t1);
# Join in either order should work here.
nqp::threadjoin($t1);
nqp::threadjoin($t2);
ok(@a[0] eq 'a',
'Looped threadyield() can force other thread to act first');
my $order := nqp::join(',', @a);
my $ok := $order eq 'a,1,b,2,c';
ok($ok, 'threadyield() properly interleaved two child threads');
say("# execution order = $order (expected a,1,b,2,c)") if !$ok;
}
# XXXX: Stress tests -- Perl 6 spectests starting at S17-lowlevel/thread.t:100
|
