Commit | Line | Data |
f9dff5f5 |
1 | |
2 | BEGIN { |
3 | chdir 't' if -d 't'; |
8abd20a8 |
4 | @INC = qw(../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; |
f1f3224a |
15 | BEGIN { $| = 1; print "1..17\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; |
f9dff5f5 |
43 | if(@_) { |
44 | $ret = threads->new(\&dorecurse, @_); |
f1f3224a |
45 | $ret &= $ret->join; |
f9dff5f5 |
46 | } |
f1f3224a |
47 | $val; |
f9dff5f5 |
48 | } |
49 | { |
f1f3224a |
50 | curr_test(6); |
51 | |
52 | my $t = threads->new(\&dorecurse, 6..10); |
53 | ok($t->join()); |
f9dff5f5 |
54 | } |
55 | |
56 | { |
f1f3224a |
57 | curr_test(7); |
58 | |
f9dff5f5 |
59 | # test that sleep lets other thread run |
f1f3224a |
60 | my $t = threads->new(\&dorecurse, 1); |
f9dff5f5 |
61 | sleep 1; |
f1f3224a |
62 | ok(1); |
63 | ok($t->join()); |
f9dff5f5 |
64 | } |
65 | { |
66 | my $lock : shared; |
67 | sub islocked { |
68 | lock($lock); |
69 | my $val = shift; |
70 | my $ret; |
71 | print $val; |
72 | if (@_) { |
73 | $ret = threads->new(\&islocked, shift); |
74 | } |
75 | return $ret; |
76 | } |
f1f3224a |
77 | my $t = threads->new(\&islocked, "ok 9\n", "ok 10\n"); |
f9dff5f5 |
78 | $t->join->join; |
79 | } |
80 | |
81 | |
82 | |
83 | sub testsprintf { |
84 | my $testno = shift; |
85 | my $same = sprintf( "%0.f", $testno); |
8abd20a8 |
86 | return $testno eq $same; |
f9dff5f5 |
87 | } |
88 | |
89 | sub threaded { |
8abd20a8 |
90 | my ($string, $string_end) = @_; |
f9dff5f5 |
91 | |
92 | # Do the match, saving the output in appropriate variables |
93 | $string =~ /(.*)(is)(.*)/; |
94 | # Yield control, allowing the other thread to fill in the match variables |
95 | threads->yield(); |
96 | # Examine the match variable contents; on broken perls this fails |
8abd20a8 |
97 | return $3 eq $string_end; |
f9dff5f5 |
98 | } |
99 | |
100 | |
101 | { |
f1f3224a |
102 | curr_test(11); |
8abd20a8 |
103 | |
f1f3224a |
104 | my $thr1 = threads->new(\&testsprintf, 11); |
105 | my $thr2 = threads->new(\&testsprintf, 12); |
f9dff5f5 |
106 | |
107 | my $short = "This is a long string that goes on and on."; |
108 | my $shorte = " a long string that goes on and on."; |
109 | my $long = "This is short."; |
110 | my $longe = " short."; |
111 | my $foo = "This is bar bar bar."; |
112 | my $fooe = " bar bar bar."; |
8abd20a8 |
113 | my $thr3 = new threads \&threaded, $short, $shorte; |
114 | my $thr4 = new threads \&threaded, $long, $longe; |
f1f3224a |
115 | my $thr5 = new threads \&testsprintf, 15; |
116 | my $thr6 = new threads \&testsprintf, 16; |
8abd20a8 |
117 | my $thr7 = new threads \&threaded, $foo, $fooe; |
118 | |
119 | ok($thr1->join()); |
120 | ok($thr2->join()); |
121 | ok($thr3->join()); |
122 | ok($thr4->join()); |
123 | ok($thr5->join()); |
124 | ok($thr6->join()); |
125 | ok($thr7->join()); |
f9dff5f5 |
126 | } |