Upgrade to threads::shared 1.29
[perl.git] / 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