ext/threads-shared/t/stress.t

   1 use strict;
   2 use warnings;
   3
   4 BEGIN {
   5     use Config;
   6     if (! $Config{'useithreads'}) {
   7         print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
   8         exit(0);
   9     }
  10     if ($^O eq 'hpux' && $Config{osvers} <= 10.20) {
  11         print("1..0 # SKIP Broken under HP-UX 10.20\n");
  12         exit(0);
  13     }
  14 }
  15
  16 use ExtUtils::testlib;
  17
  18 BEGIN {
  19     $| = 1;
  20     print("1..1\n");   ### Number of tests that will be run ###
  21 };
  22
  23 use threads;
  24 use threads::shared;
  25
  26 ### Start of Testing ###
  27
  28 #####
  29 #
  30 # Launches a bunch of threads which are then
  31 # restricted to finishing in numerical order
  32 #
  33 #####
  34 {
  35     my $cnt = 50;
  36
  37     my $TIMEOUT = 60;
  38
  39     my $mutex = 1;
  40     share($mutex);
  41
  42     my @threads;
  43     for (reverse(1..$cnt)) {
  44         $threads[$_] = threads->create(sub {
  45                             my $tnum = shift;
  46                             my $timeout = time() + $TIMEOUT;
  47                             threads->yield();
  48
  49                             # Randomize the amount of work the thread does
  50                             my $sum;
  51                             for (0..(500000+int(rand(500000)))) {
  52                                 $sum++
  53                             }
  54
  55                             # Lock the mutex
  56                             lock($mutex);
  57
  58                             # Wait for my turn to finish
  59                             while ($mutex != $tnum) {
  60                                 if (! cond_timedwait($mutex, $timeout)) {
  61                                     if ($mutex == $tnum) {
  62                                         return ('timed out - cond_broadcast not received');
  63                                     } else {
  64                                         return ('timed out');
  65                                     }
  66                                 }
  67                             }
  68
  69                             # Finish up
  70                             $mutex++;
  71                             cond_broadcast($mutex);
  72                             return ('okay');
  73                       }, $_);
  74     }
  75
  76     # Gather thread results
  77     my ($okay, $failures, $timeouts, $unknown) = (0, 0, 0, 0);
  78     for (1..$cnt) {
  79         if (! $threads[$_]) {
  80             $failures++;
  81         } else {
  82             my $rc = $threads[$_]->join();
  83             if (! $rc) {
  84                 $failures++;
  85             } elsif ($rc =~ /^timed out/) {
  86                 $timeouts++;
  87             } elsif ($rc eq 'okay') {
  88                 $okay++;
  89             } else {
  90                 $unknown++;
  91                 print(STDERR "# Unknown error: $rc\n");
  92             }
  93         }
  94     }
  95     if ($failures) {
  96         # Most likely due to running out of memory
  97         print(STDERR "# Warning: $failures threads failed\n");
  98         print(STDERR "# Note: errno 12 = ENOMEM\n");
  99         $cnt -= $failures;
 100     }
 101
 102     if ($unknown || (($okay + $timeouts) != $cnt)) {
 103         print("not ok 1\n");
 104         my $too_few = $cnt - ($okay + $timeouts + $unknown);
 105         print(STDERR "# Test failed:\n");
 106         print(STDERR "#\t$too_few too few threads reported\n") if $too_few;
 107         print(STDERR "#\t$unknown unknown errors\n")           if $unknown;
 108         print(STDERR "#\t$timeouts threads timed out\n")       if $timeouts;
 109
 110     } elsif ($timeouts) {
 111         # Frequently fails under MSWin32 due to deadlocking bug in Windows
 112         # hence test is TODO under MSWin32
 113         #   http://rt.perl.org/rt3/Public/Bug/Display.html?id=41574
 114         #   http://support.microsoft.com/kb/175332
 115         if ($^O eq 'MSWin32') {
 116             print("not ok 1 # TODO - not reliable under MSWin32\n")
 117         } else {
 118             print("not ok 1\n");
 119             print(STDERR "# Test failed: $timeouts threads timed out\n");
 120         }
 121
 122     } else {
 123         print("ok 1\n");
 124     }
 125 }
 126
 127 exit(0);
 128
 129 # EOF