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