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