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