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