This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
stop waithires.t failing under high load
authorDavid Mitchell <davem@iabyn.com>
Fri, 15 Apr 2011 09:17:07 +0000 (10:17 +0100)
committerDavid Mitchell <davem@iabyn.com>
Fri, 15 Apr 2011 09:23:43 +0000 (10:23 +0100)
In threads::shared, the waithires.t test checks cond_timedwait() with
sub-second timeouts. If the newly-minted child doesn't manage to grab the
lock within 0.05s, the cond_timedwait() will timeout, and the child and
the test will hang, until eventually killed off by the watchdog.  This can
easily happen on a slow/loaded system.

We fix this by putting the cond_timedwait() in a retry loop, only giving
up after 10 seconds of repeated timeouts.

dist/threads-shared/t/waithires.t

index e3a1086..3c3e852 100644 (file)
@@ -70,6 +70,24 @@ my @wait_how = (
     "twain"    # cond var != lock var; explicit lock; e.g.: cond_wait($c, $l)
 );
 
+# run cond_timedwait, and repeat if it times out (give up after 10 secs)
+
+sub cond_timedwaitN {
+    my $ok;
+    my $end = time() + 10;
+    while (1) {
+       if (@_ == 3) {
+           $ok = cond_timedwait($_[0], $_[1], $_[2]);
+       }
+       else {
+           $ok = cond_timedwait($_[0], $_[1]);
+       }
+       last if $ok;
+       last if time() > $end;
+    }
+    return $ok;
+}
+
 
 SYNC_SHARED: {
     my $test_type :shared;   # simple|repeat|twain
@@ -111,9 +129,9 @@ SYNC_SHARED: {
         my $thr = threads->create(\&signaller, $testnum);
         my $ok = 0;
         for ($test_type) {
-            $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/;
+            $ok = cond_timedwaitN($cond, time() + $to), last        if /simple/;
+            $ok = cond_timedwaitN($cond, time() + $to, $cond), last if /repeat/;
+            $ok = cond_timedwaitN($cond, time() + $to, $lock), last if /twain/;
             die "$test_type: unknown test\n";
         }
         $testnum = $thr->join();
@@ -215,9 +233,9 @@ SYNCH_REFS: {
         my $thr = threads->create(\&signaller2, $testnum);
         my $ok = 0;
         for ($test_type) {
-            $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/;
+            $ok = cond_timedwaitN($cond, time() + $to), last        if /simple/;
+            $ok = cond_timedwaitN($cond, time() + $to, $cond), last if /repeat/;
+            $ok = cond_timedwaitN($cond, time() + $to, $lock), last if /twain/;
             die "$test_type: unknown test\n";
         }
         $testnum = $thr->join();