1use strict; 2use warnings; 3 4BEGIN { 5 use Config; 6 if (! $Config{'useithreads'}) { 7 print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); 8 exit(0); 9 } 10} 11 12use ExtUtils::testlib; 13 14my $test = 0; 15sub ok { 16 my ($ok, $name) = @_; 17 $test++; 18 19 # You have to do it this way or VMS will get confused. 20 if ($ok) { 21 print("ok $test - $name\n"); 22 } else { 23 print("not ok $test - $name\n"); 24 printf("# Failed test at line %d\n", (caller)[2]); 25 } 26 27 return ($ok); 28} 29 30BEGIN { 31 $| = 1; 32 print("1..61\n"); ### Number of tests that will be run ### 33}; 34 35use threads; 36ok(1, 'Loaded'); 37 38### Start of Testing ### 39 40my $cnt = 30; 41 42sub stress_re { 43 my $s = "abcd" x (1000 + $_[0]); 44 my $t = ''; 45 while ($s =~ /(.)/g) { $t .= $1 } 46 return ($s eq $t) ? 'ok' : 'not'; 47} 48 49my @threads; 50for (1..$cnt) { 51 my $thr = threads->create('stress_re', $_); 52 ok($thr, "Thread created - iter $_"); 53 push(@threads, $thr); 54} 55 56for (1..$cnt) { 57 my ($result, $thr); 58 $thr = $threads[$_-1]; 59 $result = $thr->join if $thr; 60 ok($thr && defined($result) && ($result eq 'ok'), "Thread joined - iter $_"); 61} 62 63exit(0); 64 65# EOF 66