Commit | Line | Data |
f9dff5f5 |
1 | |
2 | BEGIN { |
3 | chdir 't' if -d 't'; |
c1821372 |
4 | push @INC, '../lib','.'; |
f9dff5f5 |
5 | require Config; import Config; |
6 | unless ($Config{'useithreads'}) { |
7 | print "1..0 # Skip: no useithreads\n"; |
8 | exit 0; |
9 | } |
8abd20a8 |
10 | require "test.pl"; |
f9dff5f5 |
11 | } |
12 | |
13 | use ExtUtils::testlib; |
14 | use strict; |
9c98058e |
15 | BEGIN { $| = 1; print "1..25\n" }; |
f9dff5f5 |
16 | use threads; |
17 | use threads::shared; |
18 | |
19 | print "ok 1\n"; |
20 | |
21 | sub content { |
22 | print shift; |
23 | return shift; |
24 | } |
25 | { |
26 | my $t = threads->new(\&content, "ok 2\n", "ok 3\n", 1..1000); |
27 | print $t->join(); |
28 | } |
29 | { |
30 | my $lock : shared; |
31 | my $t; |
32 | { |
33 | lock($lock); |
34 | $t = threads->new(sub { lock($lock); print "ok 5\n"}); |
35 | print "ok 4\n"; |
36 | } |
37 | $t->join(); |
38 | } |
39 | |
40 | sub dorecurse { |
41 | my $val = shift; |
42 | my $ret; |
74bf223e |
43 | print $val; |
f9dff5f5 |
44 | if(@_) { |
45 | $ret = threads->new(\&dorecurse, @_); |
74bf223e |
46 | $ret->join; |
f9dff5f5 |
47 | } |
48 | } |
49 | { |
74bf223e |
50 | my $t = threads->new(\&dorecurse, map { "ok $_\n" } 6..10); |
51 | $t->join(); |
f9dff5f5 |
52 | } |
53 | |
54 | { |
55 | # test that sleep lets other thread run |
74bf223e |
56 | my $t = threads->new(\&dorecurse, "ok 11\n"); |
da32f63e |
57 | threads->yield; # help out non-preemptive thread implementations |
f9dff5f5 |
58 | sleep 1; |
74bf223e |
59 | print "ok 12\n"; |
60 | $t->join(); |
f9dff5f5 |
61 | } |
62 | { |
63 | my $lock : shared; |
64 | sub islocked { |
65 | lock($lock); |
66 | my $val = shift; |
67 | my $ret; |
68 | print $val; |
69 | if (@_) { |
70 | $ret = threads->new(\&islocked, shift); |
71 | } |
72 | return $ret; |
73 | } |
74bf223e |
74 | my $t = threads->new(\&islocked, "ok 13\n", "ok 14\n"); |
f9dff5f5 |
75 | $t->join->join; |
76 | } |
77 | |
78 | |
79 | |
80 | sub testsprintf { |
81 | my $testno = shift; |
82 | my $same = sprintf( "%0.f", $testno); |
8abd20a8 |
83 | return $testno eq $same; |
f9dff5f5 |
84 | } |
85 | |
86 | sub threaded { |
8abd20a8 |
87 | my ($string, $string_end) = @_; |
f9dff5f5 |
88 | |
89 | # Do the match, saving the output in appropriate variables |
90 | $string =~ /(.*)(is)(.*)/; |
91 | # Yield control, allowing the other thread to fill in the match variables |
92 | threads->yield(); |
93 | # Examine the match variable contents; on broken perls this fails |
8abd20a8 |
94 | return $3 eq $string_end; |
f9dff5f5 |
95 | } |
96 | |
97 | |
98 | { |
74bf223e |
99 | curr_test(15); |
8abd20a8 |
100 | |
74bf223e |
101 | my $thr1 = threads->new(\&testsprintf, 15); |
102 | my $thr2 = threads->new(\&testsprintf, 16); |
f9dff5f5 |
103 | |
104 | my $short = "This is a long string that goes on and on."; |
105 | my $shorte = " a long string that goes on and on."; |
106 | my $long = "This is short."; |
107 | my $longe = " short."; |
108 | my $foo = "This is bar bar bar."; |
109 | my $fooe = " bar bar bar."; |
8abd20a8 |
110 | my $thr3 = new threads \&threaded, $short, $shorte; |
111 | my $thr4 = new threads \&threaded, $long, $longe; |
74bf223e |
112 | my $thr5 = new threads \&testsprintf, 19; |
113 | my $thr6 = new threads \&testsprintf, 20; |
8abd20a8 |
114 | my $thr7 = new threads \&threaded, $foo, $fooe; |
115 | |
116 | ok($thr1->join()); |
117 | ok($thr2->join()); |
118 | ok($thr3->join()); |
119 | ok($thr4->join()); |
120 | ok($thr5->join()); |
121 | ok($thr6->join()); |
122 | ok($thr7->join()); |
f9dff5f5 |
123 | } |
38875929 |
124 | |
125 | # test that 'yield' is importable |
126 | |
127 | package Test1; |
128 | |
129 | use threads 'yield'; |
130 | yield; |
131 | main::ok(1); |
132 | |
133 | package main; |
134 | |
135 | |
136 | # test async |
137 | |
138 | { |
139 | my $th = async {return 1 }; |
140 | ok($th); |
141 | ok($th->join()); |
142 | } |
9c98058e |
143 | { |
144 | # there is a little chance this test case will falsly fail |
145 | # since it tests rand |
146 | my %rand : shared; |
147 | rand(10); |
148 | threads->new( sub { $rand{int(rand(10000000000))}++ } ) foreach 1..25; |
149 | $_->join foreach threads->list; |
150 | # use Data::Dumper qw(Dumper); |
151 | # print Dumper(\%rand); |
152 | #$val = rand(); |
153 | ok((keys %rand == 25), "Check that rand works after a new thread"); |
154 | } |
155 | |
156 | |
38875929 |
157 | |