From: Rafael Garcia-Suarez Date: Tue, 10 Apr 2007 09:41:00 +0000 (+0000) Subject: Upgrade to threads::shared 1.09 : X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=05b59262edaee36ed40f0dee54cf6528cc5613e6;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 Discussion Forum on CPAN: L Annotated POD for L: -L +L + +Source repository: +L L, L diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs index 0072baa..6f7aabc 100644 --- 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 --- 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 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