Commit | Line | Data |
0f1612a7 |
1 | use strict; |
2 | use warnings; |
3 | |
31623e47 |
4 | BEGIN { |
0f1612a7 |
5 | if ($ENV{'PERL_CORE'}){ |
6 | chdir 't'; |
7 | unshift @INC, '../lib'; |
8 | } |
9 | use Config; |
31623e47 |
10 | unless ($Config{'useithreads'}) { |
11 | print "1..0 # Skip: no useithreads\n"; |
12 | exit 0; |
13 | } |
14 | } |
15 | |
16 | use ExtUtils::testlib; |
0f1612a7 |
17 | |
31623e47 |
18 | BEGIN { print "1..64\n" }; |
19 | use threads; |
20 | |
21 | |
22 | print "ok 1\n"; |
23 | |
24 | |
25 | |
26 | |
27 | sub ok { |
28 | my ($id, $ok, $name) = @_; |
29 | |
30 | # You have to do it this way or VMS will get confused. |
31 | print $ok ? "ok $id - $name\n" : "not ok $id - $name\n"; |
32 | |
33 | printf "# Failed test at line %d\n", (caller)[2] unless $ok; |
34 | |
35 | return $ok; |
36 | } |
37 | |
38 | |
39 | ok(2,1,""); |
40 | |
41 | sub test9 { |
0f85ce8a |
42 | my $s = "abcd" x (1000 + $_[0]); |
31623e47 |
43 | my $t = ''; |
44 | while ($s =~ /(.)/g) { $t .= $1 } |
45 | print "not ok $_[0]\n" if $s ne $t; |
46 | } |
47 | my @threads; |
48 | for(3..33) { |
49 | ok($_,1,"Multiple thread test"); |
50 | push @threads ,threads->create('test9',$_); |
51 | } |
52 | |
53 | my $i = 34; |
54 | for(@threads) { |
55 | $_->join; |
56 | ok($i++,1,"Thread joined"); |
57 | } |
58 | |