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