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