threads-shared v1.12

Author: jdhedden

Changes

@@ -1,5 +1,9 @@
 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
 	- Modify stress test to be TODO under MSWin32
 	- Store user locks safely

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.

shared.pm

@@ -5,7 +5,7 @@ use 5.008;
 use strict;
 use warnings;
 
-our $VERSION = '1.11';
+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/>

t/stress.t

@@ -11,6 +11,10 @@ BEGIN {
         print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
         exit(0);
     }
+    if ($^O eq 'hpux' && $Config{osvers} <= 10.20) {
+        print("1..0 # Skip: Broken under HP-UX 10.20\n");
+        exit(0);
+    }
 }
 
 use ExtUtils::testlib;

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");
     }