ext/threads/t/stress_re.t

   1 use strict;
   2 use warnings;
   3
   4 BEGIN {
   5     if ($ENV{'PERL_CORE'}){
   6         chdir 't';
   7         unshift @INC, '../lib';
   8     }
   9     use Config;
  10     unless ($Config{'useithreads'}) {
  11         print "1..0 # Skip: no useithreads\n";
  12         exit 0;
  13     }
  14 }
  15
  16 use ExtUtils::testlib;
  17
  18 BEGIN { print "1..64\n" };
  19 use threads;
  20
  21
  22 print "ok 1\n";
  23
  24
  25
  26
  27 sub 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
  39 ok(2,1,"");
  40
  41 sub test9 {
  42   my $s = "abcd" x (1000 + $_[0]);
  43   my $t = '';
  44   while ($s =~ /(.)/g) { $t .= $1 }
  45   print "not ok $_[0]\n" if $s ne $t;
  46 }
  47 my @threads;
  48 for(3..33) {
  49   ok($_,1,"Multiple thread test");
  50   push @threads ,threads->create('test9',$_);
  51 }
  52
  53 my $i = 34;
  54 for(@threads) {
  55   $_->join;
  56   ok($i++,1,"Thread joined");
  57 }
  58