From: Jerry D. Hedden Date: Wed, 23 May 2007 09:28:28 +0000 (-0400) Subject: threads::shared 1.12 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f38680ff5da7445556a1a958872817d9baf61af1;p=p5sagit%2Fp5-mst-13.2.git threads::shared 1.12 From: "Jerry D. Hedden" Message-ID: <1ff86f510705230628n73c16e2gc67a3ec05d57c5f3@mail.gmail.com> p4raw-id: //depot/perl@31262 --- diff --git a/ext/threads/shared/Changes b/ext/threads/shared/Changes index 53f5328..7704583 100644 --- a/ext/threads/shared/Changes +++ b/ext/threads/shared/Changes @@ -1,6 +1,7 @@ Revision history for Perl extension threads::shared. -- +1.12 Wed May 23 09:21:35 EDT 2007 + - Fixed 'Confused test output' problems with tests - Skip stress test under HP-UX 10.20 1.11 Mon May 14 12:13:37 2007 diff --git a/ext/threads/shared/README b/ext/threads/shared/README index 09b4f48..fab93d9 100644 --- a/ext/threads/shared/README +++ b/ext/threads/shared/README @@ -1,4 +1,4 @@ -threads::shared version 1.11 +threads::shared version 1.12 ============================ 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 4b42667..fe8cf6e 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.11_01'; +our $VERSION = '1.12'; 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.11 +This document describes threads::shared version 1.12 =head1 SYNOPSIS @@ -368,7 +368,7 @@ L Discussion Forum on CPAN: L Annotated POD for L: -L +L Source repository: L diff --git a/ext/threads/shared/t/wait.t b/ext/threads/shared/t/wait.t index b0c7d9e..4b5bd8e 100644 --- a/ext/threads/shared/t/wait.t +++ b/ext/threads/shared/t/wait.t @@ -33,7 +33,7 @@ sub ok { BEGIN { $| = 1; - print("1..103\n"); ### Number of tests that will be run ### + print("1..91\n"); ### Number of tests that will be run ### }; use threads; @@ -55,6 +55,7 @@ $Base++; # RedHat users should see https://rhn.redhat.com/errata/RHBA-2003-136.html # and consider upgrading their glibc. + sub forko (&$$); # To prevent deadlock from underlying pthread_* bugs (as in # stock RH9 glibc/NPTL) or from our own errors, we run tests # in separately forked and alarmed processes. @@ -68,14 +69,11 @@ sub forko (&$$); # To prevent deadlock from underlying pthread_* bugs (as in my $bump = $expected; - $patience ||= 60; - unless (defined($pid = open(CHLD, "-|"))) { die "fork: $!\n"; } if (! $pid) { # Child -- run the test - $patience ||= 60; - alarm $patience; + alarm($patience || 60); &$code; exit; } @@ -89,14 +87,13 @@ sub forko (&$$); # To prevent deadlock from underlying pthread_* bugs (as in close(CHLD); while ($expected--) { - $test_num++; - print "not ok $test_num - child status $?\n"; + ok(++$test_num, 0, "missing test result: child status $?"); } $Base += $bump; - }; + # - TEST basics ok(1, defined &cond_wait, "cond_wait() present"); @@ -140,29 +137,24 @@ SYNC_SHARED: { foreach (@wait_how) { $test = "cond_wait [$_]"; threads->create(\&cw)->join; - $Base += 6; + $Base += 5; } - }, 6*@wait_how, 90); + }, 5*@wait_how, 90); sub cw { - my $thr; - - { # -- begin lock scope; which lock to obtain? + # which lock to obtain? $test =~ /twain/ ? lock($lock) : lock($cond); ok(1,1, "$test: obtained initial lock"); - $thr = threads->create(\&signaller); + my $thr = threads->create(\&signaller); for ($test) { cond_wait($cond), last if /simple/; cond_wait($cond, $cond), last if /repeat/; cond_wait($cond, $lock), last if /twain/; - die "$test: unknown test\n"; + die "$test: unknown test\n"; } + $thr->join; ok(5,1, "$test: condition obtained"); - } # -- end lock scope - - $thr->join; - ok(6,1, "$test: join completed"); } # - TEST cond_timedwait success @@ -171,31 +163,27 @@ SYNC_SHARED: { foreach (@wait_how) { $test = "cond_timedwait [$_]"; threads->create(\&ctw, 5)->join; - $Base += 6; + $Base += 5; } - }, 6*@wait_how, 90); + }, 5*@wait_how, 90); sub ctw($) { - my $to = shift; - my $thr; + my $to = shift; - { # -- begin lock scope; which lock to obtain? + # which lock to obtain? $test =~ /twain/ ? lock($lock) : lock($cond); ok(1,1, "$test: obtained initial lock"); - $thr = threads->create(\&signaller); + my $thr = threads->create(\&signaller); my $ok = 0; for ($test) { $ok=cond_timedwait($cond, time() + $to), last if /simple/; $ok=cond_timedwait($cond, time() + $to, $cond), last if /repeat/; $ok=cond_timedwait($cond, time() + $to, $lock), last if /twain/; - die "$test: unknown test\n"; + die "$test: unknown test\n"; } + $thr->join; ok(5,$ok, "$test: condition obtained"); - } # -- end lock scope - - $thr->join; - ok(6,1, "$test: join completed"); } # - TEST cond_timedwait timeout @@ -231,7 +219,7 @@ SYNC_SHARED: { $ok=cond_timedwait($cond, time() + $to), last if /simple/; $ok=cond_timedwait($cond, time() + $to, $cond), last if /repeat/; $ok=cond_timedwait($cond, time() + $to, $lock), last if /twain/; - die "$test: unknown test\n"; + die "$test: unknown test\n"; } ok(2,!defined($ok), "$test: timeout"); } @@ -244,7 +232,7 @@ SYNC_SHARED: { SYNCH_REFS: { my $test : shared; # simple|repeat|twain - + my $true_cond; share($true_cond); my $true_lock; share($true_lock); @@ -272,29 +260,24 @@ SYNCH_REFS: { foreach (@wait_how) { $test = "cond_wait [$_]"; threads->create(\&cw2)->join; - $Base += 6; + $Base += 5; } - }, 6*@wait_how, 90); + }, 5*@wait_how, 90); sub cw2 { - my $thr; - - { # -- begin lock scope; which lock to obtain? + # which lock to obtain? $test =~ /twain/ ? lock($lock) : lock($cond); ok(1,1, "$test: obtained initial lock"); - $thr = threads->create(\&signaller2); + my $thr = threads->create(\&signaller2); for ($test) { cond_wait($cond), last if /simple/; cond_wait($cond, $cond), last if /repeat/; cond_wait($cond, $lock), last if /twain/; - die "$test: unknown test\n"; + die "$test: unknown test\n"; } + $thr->join; ok(5,1, "$test: condition obtained"); - } # -- end lock scope - - $thr->join; - ok(6,1, "$test: join completed"); } # - TEST cond_timedwait success @@ -303,31 +286,27 @@ SYNCH_REFS: { foreach (@wait_how) { $test = "cond_timedwait [$_]"; threads->create(\&ctw2, 5)->join; - $Base += 6; + $Base += 5; } - }, 6*@wait_how, 90); + }, 5*@wait_how, 90); sub ctw2($) { - my $to = shift; - my $thr; + my $to = shift; - { # -- begin lock scope; which lock to obtain? + # which lock to obtain? $test =~ /twain/ ? lock($lock) : lock($cond); ok(1,1, "$test: obtained initial lock"); - $thr = threads->create(\&signaller2); + my $thr = threads->create(\&signaller2); my $ok = 0; for ($test) { $ok=cond_timedwait($cond, time() + $to), last if /simple/; $ok=cond_timedwait($cond, time() + $to, $cond), last if /repeat/; $ok=cond_timedwait($cond, time() + $to, $lock), last if /twain/; - die "$test: unknown test\n"; + die "$test: unknown test\n"; } + $thr->join; ok(5,$ok, "$test: condition obtained"); - } # -- end lock scope - - $thr->join; - ok(6,1, "$test: join completed"); } # - TEST cond_timedwait timeout @@ -363,7 +342,7 @@ SYNCH_REFS: { $ok=cond_timedwait($cond, time() + $to), last if /simple/; $ok=cond_timedwait($cond, time() + $to, $cond), last if /repeat/; $ok=cond_timedwait($cond, time() + $to, $lock), last if /twain/; - die "$test: unknown test\n"; + die "$test: unknown test\n"; } ok(2,!$ok, "$test: timeout"); } diff --git a/ext/threads/shared/t/waithires.t b/ext/threads/shared/t/waithires.t index 8620ab5..7c5ee7c 100644 --- a/ext/threads/shared/t/waithires.t +++ b/ext/threads/shared/t/waithires.t @@ -41,7 +41,7 @@ sub ok { BEGIN { $| = 1; - print("1..63\n"); ### Number of tests that will be run ### + print("1..57\n"); ### Number of tests that will be run ### }; use threads; @@ -64,6 +64,7 @@ $Base++; # RedHat users should see https://rhn.redhat.com/errata/RHBA-2003-136.html # and consider upgrading their glibc. + sub forko (&$$); # To prevent deadlock from underlying pthread_* bugs (as in # stock RH9 glibc/NPTL) or from our own errors, we run tests # in separately forked and alarmed processes. @@ -77,14 +78,11 @@ sub forko (&$$); # To prevent deadlock from underlying pthread_* bugs (as in my $bump = $expected; - $patience ||= 60; - unless (defined($pid = open(CHLD, "-|"))) { die "fork: $!\n"; } if (! $pid) { # Child -- run the test - $patience ||= 60; - alarm $patience; + alarm($patience || 60); &$code; exit; } @@ -98,14 +96,13 @@ sub forko (&$$); # To prevent deadlock from underlying pthread_* bugs (as in close(CHLD); while ($expected--) { - $test_num++; - print "not ok $test_num - child status $?\n"; + ok(++$test_num, 0, "missing test result: child status $?"); } $Base += $bump; - }; + # - TEST basics my @wait_how = ( @@ -141,19 +138,18 @@ SYNC_SHARED: { foreach (@wait_how) { $test = "cond_timedwait [$_]"; threads->create(\&ctw, 0.05)->join; - $Base += 6; + $Base += 5; } - }, 6*@wait_how, 5); + }, 5*@wait_how, 5); sub ctw($) { - my $to = shift; - my $thr; + my $to = shift; - { # -- begin lock scope; which lock to obtain? + # which lock to obtain? $test =~ /twain/ ? lock($lock) : lock($cond); ok(1,1, "$test: obtained initial lock"); - $thr = threads->create(\&signaller); + my $thr = threads->create(\&signaller); my $ok = 0; for ($test) { $ok=cond_timedwait($cond, time() + $to), last if /simple/; @@ -161,11 +157,8 @@ SYNC_SHARED: { $ok=cond_timedwait($cond, time() + $to, $lock), last if /twain/; die "$test: unknown test\n"; } + $thr->join; ok(5,$ok, "$test: condition obtained"); - } # -- end lock scope - - $thr->join; - ok(6,1, "$test: join completed"); } # - TEST cond_timedwait timeout @@ -252,19 +245,18 @@ SYNCH_REFS: { foreach (@wait_how) { $test = "cond_timedwait [$_]"; threads->create(\&ctw2, 0.05)->join; - $Base += 6; + $Base += 5; } - }, 6*@wait_how, 5); + }, 5*@wait_how, 5); sub ctw2($) { - my $to = shift; - my $thr; + my $to = shift; - { # -- begin lock scope; which lock to obtain? + # which lock to obtain? $test =~ /twain/ ? lock($lock) : lock($cond); ok(1,1, "$test: obtained initial lock"); - $thr = threads->create(\&signaller2); + my $thr = threads->create(\&signaller2); my $ok = 0; for ($test) { $ok=cond_timedwait($cond, time() + $to), last if /simple/; @@ -272,11 +264,8 @@ SYNCH_REFS: { $ok=cond_timedwait($cond, time() + $to, $lock), last if /twain/; die "$test: unknown test\n"; } + $thr->join; ok(5,$ok, "$test: condition obtained"); - } # -- end lock scope - - $thr->join; - ok(6,1, "$test: join completed"); } # - TEST cond_timedwait timeout