Move Thread::Semaphore from ext/ to dist/
[perl.git] / ext / threads / t / stress_re.t
1 use strict;
2 use warnings;
3
4 BEGIN {
5     use Config;
6     if (! $Config{'useithreads'}) {
7         print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
8         exit(0);
9     }
10 }
11
12 use ExtUtils::testlib;
13
14 my $test = 0;
15 sub 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
30 BEGIN {
31     $| = 1;
32     print("1..61\n");   ### Number of tests that will be run ###
33 };
34
35 use threads;
36 ok(1, 'Loaded');
37
38 ### Start of Testing ###
39
40 my $cnt = 30;
41
42 sub 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
49 my @threads;
50 for (1..$cnt) {
51     my $thr = threads->create('stress_re', $_);
52     ok($thr, "Thread created - iter $_");
53     push(@threads, $thr);
54 }
55
56 for (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
63 exit(0);
64
65 # EOF