Commit | Line | Data |
0f1612a7 |
1 | use strict; |
2 | use warnings; |
a54396a0 |
3 | |
83ebf7e2 |
4 | BEGIN { |
0f1612a7 |
5 | use Config; |
fc04eb16 |
6 | if (! $Config{'useithreads'}) { |
561ee912 |
7 | print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); |
fc04eb16 |
8 | exit(0); |
83ebf7e2 |
9 | } |
10 | } |
11 | |
47ba8780 |
12 | use ExtUtils::testlib; |
47ba8780 |
13 | |
fc04eb16 |
14 | sub ok { |
15 | my ($id, $ok, $name) = @_; |
47ba8780 |
16 | |
fc04eb16 |
17 | # You have to do it this way or VMS will get confused. |
18 | if ($ok) { |
19 | print("ok $id - $name\n"); |
20 | } else { |
21 | print("not ok $id - $name\n"); |
22 | printf("# Failed test at line %d\n", (caller)[2]); |
23 | } |
a54396a0 |
24 | |
fc04eb16 |
25 | return ($ok); |
26 | } |
27 | |
28 | BEGIN { |
29 | $| = 1; |
b91a79b9 |
30 | print("1..34\n"); ### Number of tests that will be run ### |
fc04eb16 |
31 | }; |
32 | |
33 | use threads; |
a54396a0 |
34 | |
242a51a4 |
35 | if ($threads::VERSION && ! $ENV{'PERL_CORE'}) { |
0f1612a7 |
36 | print(STDERR "# Testing threads $threads::VERSION\n"); |
37 | } |
47ba8780 |
38 | |
0f1612a7 |
39 | ok(1, 1, 'Loaded'); |
47ba8780 |
40 | |
0f1612a7 |
41 | ### Start of Testing ### |
5da2326b |
42 | |
fc04eb16 |
43 | ok(2, 1 == $threads::threads, "Check that threads::threads is true"); |
a54396a0 |
44 | |
5da2326b |
45 | sub test1 { |
fc04eb16 |
46 | ok(3,'bar' eq $_[0], "Test that argument passing works"); |
5da2326b |
47 | } |
fc04eb16 |
48 | threads->create('test1', 'bar')->join(); |
47ba8780 |
49 | |
5da2326b |
50 | sub test2 { |
fc04eb16 |
51 | ok(4,'bar' eq $_[0]->[0]->{'foo'}, "Test that passing arguments as references work"); |
5da2326b |
52 | } |
fc04eb16 |
53 | threads->create(\&test2, [{'foo' => 'bar'}])->join(); |
47ba8780 |
54 | |
fc04eb16 |
55 | sub test3 { |
56 | ok(5, shift() == 1, "Test a normal sub"); |
57 | } |
58 | threads->create(\&test3, 1)->join(); |
47ba8780 |
59 | |
5da2326b |
60 | |
fc04eb16 |
61 | sub test4 { |
62 | ok(6, 1, "Detach test"); |
63 | } |
64 | { |
65 | my $thread1 = threads->create('test4'); |
66 | $thread1->detach(); |
f782ee33 |
67 | while ($thread1->is_running()) { |
68 | threads->yield(); |
69 | sleep 1; |
70 | } |
fc04eb16 |
71 | } |
fc04eb16 |
72 | ok(7, 1, "Detach test"); |
5da2326b |
73 | |
74 | |
75 | sub test5 { |
fc04eb16 |
76 | threads->create('test6')->join(); |
77 | ok(9, 1, "Nested thread test"); |
47ba8780 |
78 | } |
a54396a0 |
79 | |
5da2326b |
80 | sub test6 { |
fc04eb16 |
81 | ok(8, 1, "Nested thread test"); |
5da2326b |
82 | } |
47ba8780 |
83 | |
5da2326b |
84 | threads->create('test5')->join(); |
85 | |
fc04eb16 |
86 | |
5da2326b |
87 | sub test7 { |
fc04eb16 |
88 | my $self = threads->self(); |
89 | ok(10, $self->tid == 7, "Wanted 7, got ".$self->tid); |
90 | ok(11, threads->tid() == 7, "Wanted 7, got ".threads->tid()); |
47ba8780 |
91 | } |
5da2326b |
92 | threads->create('test7')->join; |
93 | |
94 | sub test8 { |
fc04eb16 |
95 | my $self = threads->self(); |
96 | ok(12, $self->tid == 8, "Wanted 8, got ".$self->tid); |
97 | ok(13, threads->tid() == 8, "Wanted 8, got ".threads->tid()); |
5da2326b |
98 | } |
5da2326b |
99 | threads->create('test8')->join; |
47ba8780 |
100 | |
101 | |
fc04eb16 |
102 | ok(14, 0 == threads->self->tid(), "Check so that tid for threads work for main thread"); |
103 | ok(15, 0 == threads->tid(), "Check so that tid for threads work for main thread"); |
5da2326b |
104 | |
1d784c90 |
105 | { |
fc04eb16 |
106 | no warnings; |
107 | local *CLONE = sub { |
108 | ok(16, threads->tid() == 9, "Tid should be correct in the clone"); |
109 | }; |
110 | threads->create(sub { |
111 | ok(17, threads->tid() == 9, "And tid be 9 here too"); |
112 | })->join(); |
1d784c90 |
113 | } |
114 | |
fc04eb16 |
115 | { |
116 | sub Foo::DESTROY { |
117 | ok(19, threads->tid() == 10, "In destroy it should be correct too" ) |
118 | } |
1d784c90 |
119 | my $foo; |
fc04eb16 |
120 | threads->create(sub { |
121 | ok(18, threads->tid() == 10, "And tid be 10 here"); |
122 | $foo = bless {}, 'Foo'; |
123 | return undef; |
124 | })->join(); |
1d784c90 |
125 | } |
74bf223e |
126 | |
127 | |
0f1612a7 |
128 | my $thr1 = threads->create(sub {}); |
129 | my $thr2 = threads->create(sub {}); |
130 | my $thr3 = threads->object($thr1->tid()); |
131 | |
67698975 |
132 | # Make sure both overloaded '==' and '!=' are working correctly |
133 | ok(20, $thr1 != $thr2, 'Treads not equal'); |
134 | ok(21, !($thr1 == $thr2), 'Treads not equal'); |
135 | ok(22, $thr1 == $thr3, 'Threads equal'); |
136 | ok(23, !($thr1 != $thr3), 'Threads equal'); |
74bf223e |
137 | |
67698975 |
138 | ok(24, $thr1->_handle(), 'Handle method'); |
139 | ok(25, $thr2->_handle(), 'Handle method'); |
f4cc38af |
140 | |
67698975 |
141 | ok(26, threads->object($thr1->tid())->tid() == 11, 'Object method'); |
142 | ok(27, threads->object($thr2->tid())->tid() == 12, 'Object method'); |
74bf223e |
143 | |
0f1612a7 |
144 | $thr1->join(); |
145 | $thr2->join(); |
74bf223e |
146 | |
67698975 |
147 | my $sub = sub { ok(28, shift() == 1, "Test code ref"); }; |
0f1612a7 |
148 | threads->create($sub, 1)->join(); |
74bf223e |
149 | |
0f1612a7 |
150 | my $thrx = threads->object(99); |
67698975 |
151 | ok(29, ! defined($thrx), 'No object'); |
0f1612a7 |
152 | $thrx = threads->object(); |
67698975 |
153 | ok(30, ! defined($thrx), 'No object'); |
0f1612a7 |
154 | $thrx = threads->object(undef); |
67698975 |
155 | ok(31, ! defined($thrx), 'No object'); |
74bf223e |
156 | |
f3086ff0 |
157 | threads->import('stringify'); |
3ab14376 |
158 | $thr1 = threads->create(sub {}); |
b91a79b9 |
159 | ok(32, "$thr1" eq $thr1->tid(), 'Stringify'); |
3ab14376 |
160 | $thr1->join(); |
161 | |
b91a79b9 |
162 | # ->object($tid) works like ->self() when $tid is thread's TID |
163 | $thrx = threads->object(threads->tid()); |
164 | ok(33, defined($thrx), 'Main thread object'); |
165 | ok(34, 0 == $thrx->tid(), "Check so that tid for threads work for main thread"); |
166 | |
561ee912 |
167 | exit(0); |
168 | |
0f1612a7 |
169 | # EOF |