This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
(2nd revised) 1st patch to sync blead 'threads' with CPAN
[perl5.git] / ext / threads / t / stress_re.t
CommitLineData
0f1612a7
JH
1use strict;
2use warnings;
3
31623e47 4BEGIN {
0f1612a7
JH
5 if ($ENV{'PERL_CORE'}){
6 chdir 't';
7 unshift @INC, '../lib';
8 }
9 use Config;
31623e47
JH
10 unless ($Config{'useithreads'}) {
11 print "1..0 # Skip: no useithreads\n";
12 exit 0;
13 }
14}
15
16use ExtUtils::testlib;
0f1612a7 17
31623e47
JH
18BEGIN { print "1..64\n" };
19use threads;
20
21
22print "ok 1\n";
23
24
25
26
27sub ok {
28 my ($id, $ok, $name) = @_;
29
30 # You have to do it this way or VMS will get confused.
31 print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
32
33 printf "# Failed test at line %d\n", (caller)[2] unless $ok;
34
35 return $ok;
36}
37
38
39ok(2,1,"");
40
41sub test9 {
0f85ce8a 42 my $s = "abcd" x (1000 + $_[0]);
31623e47
JH
43 my $t = '';
44 while ($s =~ /(.)/g) { $t .= $1 }
45 print "not ok $_[0]\n" if $s ne $t;
46}
47my @threads;
48for(3..33) {
49 ok($_,1,"Multiple thread test");
50 push @threads ,threads->create('test9',$_);
51}
52
53my $i = 34;
54for(@threads) {
55 $_->join;
56 ok($i++,1,"Thread joined");
57}
58