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     if (! $Config{'useithreads'}) {
  11         print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
  12         exit(0);
  13     }
  14 }
  15
  16 use ExtUtils::testlib;
  17
  18 my $test = 0;
  19 sub ok {
  20     my ($ok, $name) = @_;
  21     $test++;
  22
  23     # You have to do it this way or VMS will get confused.
  24     if ($ok) {
  25         print("ok $test - $name\n");
  26     } else {
  27         print("not ok $test - $name\n");
  28         printf("# Failed test at line %d\n", (caller)[2]);
  29     }
  30
  31     return ($ok);
  32 }
  33
  34 BEGIN {
  35     $| = 1;
  36     print("1..61\n");   ### Number of tests that will be run ###
  37 };
  38
  39 use threads;
  40 ok(1, 'Loaded');
  41
  42 ### Start of Testing ###
  43
  44 my $cnt = 30;
  45
  46 sub stress_re {
  47     my $s = "abcd" x (1000 + $_[0]);
  48     my $t = '';
  49     while ($s =~ /(.)/g) { $t .= $1 }
  50     return ($s eq $t) ? 'ok' : 'not';
  51 }
  52
  53 my @threads;
  54 for (1..$cnt) {
  55     my $thr = threads->create('stress_re', $_);
  56     ok($thr, "Thread created - iter $_");
  57     push(@threads, $thr);
  58 }
  59
  60 for (1..$cnt) {
  61     my ($result, $thr);
  62     $thr = $threads[$_-1];
  63     $result = $thr->join if $thr;
  64     ok($thr && defined($result) && ($result eq 'ok'), "Thread joined - iter $_");
  65 }
  66
  67 # EOF