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