threads::shared 1.12

From: "Jerry D. Hedden" <jdhedden@cpan.org>
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 (file)
--- 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 (file)
--- 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 (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.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<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.11/shared.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-shared-1.12/shared.pm>
 
 Source repository:
 L<http://code.google.com/p/threads-shared/>

diff --git a/ext/threads/shared/t/wait.t b/ext/threads/shared/t/wait.t
index b0c7d9e..4b5bd8e 100644 (file)
--- 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 (file)
--- 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