5 if ($ENV{'PERL_CORE'}){
7 unshift @INC, '../lib';
10 if (! $Config{'useithreads'}) {
11 print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
14 if ($^O eq 'hpux' && $Config{osvers} <= 10.20) {
15 print("1..0 # Skip: Broken under HP-UX 10.20\n");
20 use ExtUtils::testlib;
24 print("1..1\n"); ### Number of tests that will be run ###
30 ### Start of Testing ###
34 # Launches a bunch of threads which are then
35 # restricted to finishing in numerical order
48 $threads[$_] = threads->create(sub {
50 my $timeout = time() + $TIMEOUT;
52 # Randomize the amount of work the thread does
54 for (0..(500000+int(rand(500000)))) {
61 # Wait for my turn to finish
62 while ($mutex != $tnum) {
63 if (! cond_timedwait($mutex, $timeout)) {
64 if ($mutex == $tnum) {
65 return ('timed out - cond_broadcast not received');
74 cond_broadcast($mutex);
79 # Gather thread results
80 my ($okay, $failures, $timeouts, $unknown) = (0, 0, 0, 0);
85 my $rc = $threads[$_]->join();
88 } elsif ($rc =~ /^timed out/) {
90 } elsif ($rc eq 'okay') {
94 print(STDERR "# Unknown error: $rc\n");
99 # Most likely due to running out of memory
100 print(STDERR "# Warning: $failures threads failed\n");
101 print(STDERR "# Note: errno 12 = ENOMEM\n");
105 if ($unknown || (($okay + $timeouts) != $cnt)) {
107 my $too_few = $cnt - ($okay + $timeouts + $unknown);
108 print(STDERR "# Test failed:\n");
109 print(STDERR "#\t$too_few too few threads reported\n") if $too_few;
110 print(STDERR "#\t$unknown unknown errors\n") if $unknown;
111 print(STDERR "#\t$timeouts threads timed out\n") if $timeouts;
113 } elsif ($timeouts) {
114 # Frequently fails under MSWin32 due to deadlocking bug in Windows
115 # hence test is TODO under MSWin32
116 # http://rt.perl.org/rt3/Public/Bug/Display.html?id=41574
117 # http://support.microsoft.com/kb/175332
118 if ($^O eq 'MSWin32') {
119 print("not ok 1 # TODO - not reliable under MSWin32\n")
122 print(STDERR "# Test failed: $timeouts threads timed out\n");
127 print(' # TODO - not reliable under MSWin32') if ($^O eq 'MSWin32');