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