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