From: Jerry D. Hedden <jdhedden@cpan.org>
Date: Wed, 18 Apr 2007 14:32:16 +0000 (-0400)
Subject: Re: [perl #41574] cond_wait hang ups under MSWin32
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3b29be8d36f4d89172a614c23fd56316977b2d95;p=p5sagit%2Fp5-mst-13.2.git

Re: [perl #41574] cond_wait hang ups under MSWin32
From: "Jerry D. Hedden" <jdhedden@cpan.org>
Message-ID: <1ff86f510704181132qf94b413mfda6aaa0f347df28@mail.gmail.com>

Makes the test "TODO" on Win32, where it is not reliable, and turns
the 50 separate tests in one single test for less line noise

p4raw-id: //depot/perl@30978
---

diff --git a/ext/threads/shared/Changes b/ext/threads/shared/Changes
index c51d226..6ff6f52 100644
--- a/ext/threads/shared/Changes
+++ b/ext/threads/shared/Changes
@@ -1,5 +1,8 @@
 Revision history for Perl extension threads::shared.
 
+-
+	- Modify stress test to be TODO under MSWin32
+
 1.09 Mon Apr  9 16:49:30 EDT 2007
 	- Modify stress test to not hang under MSWin32
 	- Fix casting issue under MSWin32
diff --git a/ext/threads/shared/shared.pm b/ext/threads/shared/shared.pm
index ff4be3f..aaae9ba 100644
--- a/ext/threads/shared/shared.pm
+++ b/ext/threads/shared/shared.pm
@@ -5,7 +5,7 @@ use 5.008;
 use strict;
 use warnings;
 
-our $VERSION = '1.09';
+our $VERSION = '1.09_01';
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -85,7 +85,7 @@ This document describes threads::shared version 1.09
   $var = $shared_ref_value;
   $var = share($simple_unshared_ref_value);
 
-  my($scalar, @array, %hash);
+  my ($scalar, @array, %hash);
   share($scalar);
   share(@array);
   share(%hash);
diff --git a/ext/threads/shared/t/stress.t b/ext/threads/shared/t/stress.t
index 85734db..f2f7d60 100644
--- a/ext/threads/shared/t/stress.t
+++ b/ext/threads/shared/t/stress.t
@@ -15,26 +15,9 @@ BEGIN {
 
 use ExtUtils::testlib;
 
-my $Base = 0;
-sub ok {
-    my ($id, $ok, $why) = @_;
-    $id += $Base;
-
-    # You have to do it this way or VMS will get confused.
-    if ($ok) {
-        print("ok $id\n");
-    } else {
-        print ("not ok $id\n");
-        printf("# Failed test at line %d\n", (caller)[2]);
-        print ("#   Reason: $why\n");
-    }
-
-    return ($ok);
-}
-
 BEGIN {
     $| = 1;
-    print("1..50\n");   ### Number of tests that will be run ###
+    print("1..1\n");   ### Number of tests that will be run ###
 };
 
 use threads;
@@ -47,10 +30,6 @@ use threads::shared;
 # Launches a bunch of threads which are then
 # restricted to finishing in numerical order
 #
-# Frequently fails under MSWin32 due to deadlocking bug in Windows
-#   http://rt.perl.org/rt3/Public/Bug/Display.html?id=41574
-#   http://support.microsoft.com/kb/175332
-#
 #####
 {
     my $cnt = 50;
@@ -94,12 +73,44 @@ use threads::shared;
     }
 
     # Gather thread results
+    my ($okay, $failures, $timeouts, $unknown) = (0, 0, 0, 0);
     for (1..$cnt) {
-        my $rc = $threads[$_]->join() || 'Thread failed';
-        ok($_, ($rc eq 'okay'), $rc);
+        my $rc = $threads[$_]->join();
+        if (! $rc) {
+            $failures++;
+        } elsif ($rc =~ /^timed out/) {
+            $timeouts++;
+        } elsif ($rc eq 'okay') {
+            $okay++;
+        } else {
+            $unknown++;
+            print("# Unknown error: $rc\n");
+        }
     }
 
-    $Base += $cnt;
+    if ($failures || $unknown || (($okay + $timeouts) != $cnt)) {
+        print('not ok 1');
+        my $too_few = $cnt - ($okay + $failures + $timeouts + $unknown);
+        print(" - $too_few too few threads reported") if $too_few;
+        print(" - $failures threads failed")          if $failures;
+        print(" - $unknown unknown errors")           if $unknown;
+        print(" - $timeouts threads timed out")       if $timeouts;
+        print("\n");
+
+    } elsif ($timeouts) {
+        # Frequently fails under MSWin32 due to deadlocking bug in Windows
+        # hence test is TODO under MSWin32
+        #   http://rt.perl.org/rt3/Public/Bug/Display.html?id=41574
+        #   http://support.microsoft.com/kb/175332
+        print('not ok 1');
+        print(' # TODO - not reliable under MSWin32') if ($^O eq 'MSWin32');
+        print(" - $timeouts threads timed out\n");
+
+    } else {
+        print('ok 1');
+        print(' # TODO - not reliable under MSWin32') if ($^O eq 'MSWin32');
+        print("\n");
+    }
 }
 
 # EOF