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
47 for (reverse(1..$cnt)) {
48 $threads[$_] = threads->create(sub {
50 my $timeout = time() + $TIMEOUT;
53 # Randomize the amount of work the thread does
55 for (0..(500000+int(rand(500000)))) {
62 # Wait for my turn to finish
63 while ($mutex != $tnum) {
64 if (! cond_timedwait($mutex, $timeout)) {
65 if ($mutex == $tnum) {
66 return ('timed out - cond_broadcast not received');
75 cond_broadcast($mutex);
80 # Gather thread results
81 my ($okay, $failures, $timeouts, $unknown) = (0, 0, 0, 0);
86 my $rc = $threads[$_]->join();
89 } elsif ($rc =~ /^timed out/) {
91 } elsif ($rc eq 'okay') {
95 print(STDERR "# Unknown error: $rc\n");
100 # Most likely due to running out of memory
101 print(STDERR "# Warning: $failures threads failed\n");
102 print(STDERR "# Note: errno 12 = ENOMEM\n");
106 if ($unknown || (($okay + $timeouts) != $cnt)) {
108 my $too_few = $cnt - ($okay + $timeouts + $unknown);
109 print(STDERR "# Test failed:\n");
110 print(STDERR "#\t$too_few too few threads reported\n") if $too_few;
111 print(STDERR "#\t$unknown unknown errors\n") if $unknown;
112 print(STDERR "#\t$timeouts threads timed out\n") if $timeouts;
114 } elsif ($timeouts) {
115 # Frequently fails under MSWin32 due to deadlocking bug in Windows
116 # hence test is TODO under MSWin32
117 # http://rt.perl.org/rt3/Public/Bug/Display.html?id=41574
118 # http://support.microsoft.com/kb/175332
119 if ($^O eq 'MSWin32') {
120 print("not ok 1 # TODO - not reliable under MSWin32\n")
123 print(STDERR "# Test failed: $timeouts threads timed out\n");