Upgrade to threads::shared 1.09 :

- Fix casting issue under MSWin32
- Modify stress test to not hang under MSWin32

p4raw-id: //depot/perl@30886

diff --git a/MANIFEST b/MANIFEST
index 2b7ae9f..6f36ac8 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1131,6 +1131,7 @@ ext/threads/shared/t/hv_refs.t    Test shared hashes containing references
 ext/threads/shared/t/hv_simple.t       Tests for basic shared hash functionality.
 ext/threads/shared/t/no_share.t        Tests for disabled share on variables.
 ext/threads/shared/t/shared_attr.t     Test :shared attribute
+ext/threads/shared/t/stress.t  Stress test
 ext/threads/shared/t/sv_refs.t thread shared variables
 ext/threads/shared/t/sv_simple.t       thread shared variables
 ext/threads/shared/t/waithires.t       Test sub-second cond_timedwait

diff --git a/ext/threads/shared/Changes b/ext/threads/shared/Changes
index a28a068..c51d226 100644 (file)
--- a/ext/threads/shared/Changes
+++ b/ext/threads/shared/Changes
@@ -1,7 +1,12 @@
 Revision history for Perl extension threads::shared.
 
-1.08 Wed Mar 14 12:40:57 EDT 2007
-       - Sub-second resolution for cont_timedwait under WIN32
+1.09 Mon Apr  9 16:49:30 EDT 2007
+       - Modify stress test to not hang under MSWin32
+       - Fix casting issue under MSWin32
+       - Subversion repository on Google
+
+1.08 Fri Mar 16 08:31:50 EDT 2007
+       - Sub-second resolution for cont_timedwait under MSWin32
            (courtesy of Dean Arnold)
        - Fix compiler warnings
        - Upgraded ppport.h to Devel::PPPort 3.11

diff --git a/ext/threads/shared/README b/ext/threads/shared/README
index b351b01..08039b5 100644 (file)
--- a/ext/threads/shared/README
+++ b/ext/threads/shared/README
@@ -1,4 +1,4 @@
-threads::shared version 1.08
+threads::shared version 1.09
 ============================
 
 This module needs Perl 5.8.0 or later compiled with USEITHREADS.

diff --git a/ext/threads/shared/shared.pm b/ext/threads/shared/shared.pm
index dacd50c..ff4be3f 100644 (file)
--- 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.08_01';
+our $VERSION = '1.09';
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -73,7 +73,7 @@ threads::shared - Perl extension for sharing data structures between threads
 
 =head1 VERSION
 
-This document describes threads::shared version 1.08
+This document describes threads::shared version 1.09
 
 =head1 SYNOPSIS
 
@@ -368,7 +368,10 @@ L<threads::shared> Discussion Forum on CPAN:
 L<http://www.cpanforum.com/dist/threads-shared>
 
 Annotated POD for L<threads::shared>:
-L<http://annocpan.org/~JDHEDDEN/threads-shared-1.08/shared.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-shared-1.09/shared.pm>
+
+Source repository:
+L<http://code.google.com/p/threads-shared/>
 
 L<threads>, L<perlthrtut>
 

diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index 0072baa..6f7aabc 100644 (file)
--- a/ext/threads/shared/shared.xs
+++ b/ext/threads/shared/shared.xs
@@ -115,25 +115,13 @@
  * without the prefix (e.g., sv, tmp or obj).
  */
 
-/* Patch status:
- *
- * Perl 5.8.8 contains threads::shared patches up to 26626 (equivalent to
- * blead patches 26350+26351).
- *
- * The CPAN version of threads::shared contains the following blead patches:
- *      26569 (applicable to 5.9.3 only)
- *      26684
- *      26693
- *      26695
- */
-
 #define PERL_NO_GET_CONTEXT
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
 #ifdef HAS_PPPORT_H
-#define NEED_vnewSVpvf
-#define NEED_warner
+#  define NEED_vnewSVpvf
+#  define NEED_warner
 #  include "ppport.h"
 #  include "shared.h"
 #endif
@@ -562,15 +550,14 @@ S_abs_2_rel_milli(double abs)
 
     /* Get current time (in units of 100 nanoseconds since 1/1/1601) */
     union {
-        FILETIME         ft;
-        unsigned __int64 i64;
+        FILETIME ft;
+        __int64  i64;   /* 'signed' to keep compilers happy */
     } now;
 
     GetSystemTimeAsFileTime(&now.ft);
 
     /* Relative time in milliseconds */
     rel = (abs * 1000.) - (((double)now.i64 / 10000.) - EPOCH_BIAS);
-
     if (rel <= 0.0) {
         return (0);
     }

diff --git a/ext/threads/shared/t/cond.t b/ext/threads/shared/t/cond.t
index 7f18950..962bf16 100644 (file)
--- a/ext/threads/shared/t/cond.t
+++ b/ext/threads/shared/t/cond.t
@@ -33,7 +33,7 @@ sub ok {
 
 BEGIN {
     $| = 1;
-    print("1..82\n");   ### Number of tests that will be run ###
+    print("1..32\n");   ### Number of tests that will be run ###
 };
 
 use threads;
@@ -282,38 +282,4 @@ $Base++;
     $Base += 4;
 }
 
-
-# Stress test
-{
-    my $cnt = 50;
-
-    my $mutex = 1;
-    share($mutex);
-
-    my @threads;
-    for (1..$cnt) {
-        $threads[$_] = threads->create(sub {
-                            my $arg = shift;
-                            my $result = 0;
-                            for (0..1000000) {
-                                $result++;
-                            }
-                            lock($mutex);
-                            while ($mutex != $arg) {
-                                cond_wait($mutex);
-                            }
-                            $mutex++;
-                            cond_broadcast($mutex);
-                            return $result;
-                      }, $_);
-    }
-
-    for (1..$cnt) {
-        my $result = $threads[$_]->join();
-        ok($_, defined($result) && ("$result" eq '1000001'), "stress test - iter $_");
-    }
-
-    $Base += $cnt;
-}
-
 # EOF

diff --git a/ext/threads/shared/t/stress.t b/ext/threads/shared/t/stress.t
new file mode 100644 (file)
index 0000000..3f4493c
--- /dev/null
+++ b/ext/threads/shared/t/stress.t
@@ -0,0 +1,210 @@
+use strict;
+use warnings;
+
+BEGIN {
+    if ($ENV{'PERL_CORE'}){
+        chdir 't';
+        unshift @INC, '../lib';
+    }
+    use Config;
+    if (! $Config{'useithreads'}) {
+        print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
+        exit(0);
+    }
+}
+
+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 ###
+};
+
+use threads;
+use threads::shared;
+
+### Start of Testing ###
+
+#####
+#
+# 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;
+
+    my $TIMEOUT = 30;
+
+    my $mutex = 1;
+    share($mutex);
+
+    my @threads;
+    for (1..$cnt) {
+        $threads[$_] = threads->create(sub {
+                            my $tnum = shift;
+                            my $timeout = time() + $TIMEOUT;
+
+                            # Randomize the amount of work the thread does
+                            my $sum;
+                            for (0..(500000+int(rand(500000)))) {
+                                $sum++
+                            }
+
+                            # Lock the mutex
+                            lock($mutex);
+
+                            # Wait for my turn to finish
+                            while ($mutex != $tnum) {
+                                if (! cond_timedwait($mutex, $timeout)) {
+                                    if ($mutex == $tnum) {
+                                        return ('timed out - cond_broadcast not received');
+                                    } else {
+                                        return ('timed out');
+                                    }
+                                }
+                            }
+
+                            # Finish up
+                            $mutex++;
+                            cond_broadcast($mutex);
+                            return ('okay');
+                      }, $_);
+    }
+
+    # Gather thread results
+    for (1..$cnt) {
+        my $rc = $threads[$_]->join() || 'Thread failed';
+        ok($_, ($rc eq 'okay'), $rc);
+    }
+
+    $Base += $cnt;
+}
+
+# EOF
+use strict;
+use warnings;
+
+BEGIN {
+    if ($ENV{'PERL_CORE'}){
+        chdir 't';
+        unshift @INC, '../lib';
+    }
+    use Config;
+    if (! $Config{'useithreads'}) {
+        print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
+        exit(0);
+    }
+}
+
+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 ###
+};
+
+use threads;
+use threads::shared;
+
+### Start of Testing ###
+
+#####
+#
+# 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;
+
+    my $TIMEOUT = 30;
+
+    my $mutex = 1;
+    share($mutex);
+
+    my @threads;
+    for (1..$cnt) {
+        $threads[$_] = threads->create(sub {
+                            my $tnum = shift;
+                            my $timeout = time() + $TIMEOUT;
+
+                            # Randomize the amount of work the thread does
+                            my $sum;
+                            for (0..(500000+int(rand(500000)))) {
+                                $sum++
+                            }
+
+                            # Lock the mutex
+                            lock($mutex);
+
+                            # Wait for my turn to finish
+                            while ($mutex != $tnum) {
+                                if (! cond_timedwait($mutex, $timeout)) {
+                                    if ($mutex == $tnum) {
+                                        return ('timed out - cond_broadcast not received');
+                                    } else {
+                                        return ('timed out');
+                                    }
+                                }
+                            }
+
+                            # Finish up
+                            $mutex++;
+                            cond_broadcast($mutex);
+                            return ('okay');
+                      }, $_);
+    }
+
+    # Gather thread results
+    for (1..$cnt) {
+        my $rc = $threads[$_]->join() || 'Thread failed';
+        ok($_, ($rc eq 'okay'), $rc);
+    }
+
+    $Base += $cnt;
+}
+
+# EOF