cond_timedwait pause and cond_timedwait instant on EBCDIC platform

[mohammad yaseen]

Hi,

This is part of the testcase wait.t which is failing on EBCDIC platform. I'm using perl-5.8.7.

 

# cond_wait and cond_timedwait extended tests
# adapted from cond.t

use warnings;

BEGIN {
    chdir 't' if -d 't';
    push @INC ,'../lib';
    require Config; import Config;
    unless ($Config{'useithreads'}) {
        print "1..0 # Skip: no threads\n";
        exit 0;
    }
}
$|++;
print "1..102\n";
use strict;

use threads;
use threads::shared;
use ExtUtils::testlib;

my $Base = 0;

sub ok {
    my ($offset, $bool, $text) = @_;
    my $not = '';
    $not = "not " unless $bool;
    print "${not}ok " . ($Base + $offset) . " - $text\n";
}

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.

*forko = ($^O =~ /^dos|os2|mswin32|netware|vms$/i)
? sub (&$$) { my $code = shift; goto &$code; }
: sub (&$$) {
  my ($code, $expected, $patience) = @_;
  my ($test_num, $pid);
  local *CHLD;

  my $bump = $expected;

  $patience ||= 60;

  unless (defined($pid = open(CHLD, "-|"))) {

die "fork: $!\n";
  }
  if (! $pid) {   # Child -- run the test
    $patience ||= 60;
    alarm $patience;
    &$code;
    exit;
  }

  while (<CHLD>) {
    $expected--, $test_num=$1 if /^(?:not )?ok (\d+)/;
    #print "#forko: ($expected, $1) $_";
    print;
  }

  close(CHLD);

  while ($expected--) {
    $test_num++;
    print "not ok $test_num - child status $?\n";
  }

  $Base += $bump;

};

# - TEST basics
my @wait_how = (
   "simple",  # cond var == lock var; implicit lock; e.g.: cond_wait($c)
   "repeat",  # cond var == lock var; explicit lock; e.g.: cond_wait($c, $c)
   "twain"    # cond var != lock var; explicit lock; e.g.: cond_wait($c, $l)
);

SYNC_SHARED: {
  my $test : shared;  # simple|repeat|twain
  my $cond : shared;
  my $lock : shared;

  print "# testing my \$var : shared\n";
  ok(1, 1, "Shared synchronization tests preparation");
  $Base += 1;

  sub signaller {
    ok(2,1,"$test: child before lock");
    $test =~ /twain/ ? lock($lock) : lock($cond);
    ok(3,1,"$test: child obtained lock");

if ($test =~ 'twain') {
      no warnings 'threads';   # lock var != cond var, so disable warnings
      cond_signal($cond);
    } else {
      cond_signal($cond);
    }
    ok(4,1,"$test: child signalled condition");
  }

  # - TEST cond_timedwait timeout

  forko( sub {
    foreach (@wait_how) {
      $test = "cond_timedwait pause, timeout [$_]";
      threads->create(\&ctw_fail, 3)->join;
      $Base += 2;
    }
  }, [EMAIL PROTECTED], 90);

  forko( sub {

foreach (@wait_how) {
      $test = "cond_timedwait instant timeout [$_]";
      threads->create(\&ctw_fail, -60)->join;
      $Base += 2;
    }
  }, [EMAIL PROTECTED], 90);

  # cond_timedwait timeout (relative timeout)
  sub ctw_fail {
    my $to = shift;

    $test =~ /twain/ ? lock($lock) : lock($cond);
    ok(1,1, "$test: obtained initial lock");
    my $ok;
        print "c=$cond\nti=time()\nto=$to\n";
    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";
    }
    ok(2,!defined($ok), "$test: timeout");
  }

}

 

Result:

1..102
# testing my $var : shared
ok 1 - Shared synchronization tests preparation
ok 2 - cond_timedwait pause, timeout [simple]: obtained initial lock
panic: MUTEX_LOCK (-1) [shared.xs:90] at wait line 109.
Callback called exit at wait line 109.
not ok 3 - child status 29696
not ok 4 - child status 29696
not ok 5 - child status 29696
not ok 6 - child status 29696
not ok 7 - child status 29696
ok 8 - cond_timedwait instant timeout [simple]: obtained initial lock
panic: MUTEX_LOCK (-1) [shared.xs:90] at wait line 117.
Callback called exit at wait line 117.
not ok 9 - child status 29696
not ok 10 - child status 29696
not ok 11 - child status 29696
not ok 12 - child status 29696
not ok 13 - child status 29696

 

The first error message is coming out of MUTEX_LOCK macro which is calling pthread_mutex_lock and this is failing.

Is this problem causing due to the difference in pthreads library implementation ?

If not whether it is due to the implementation of fork on our platform?

 

Regards

Yaseen

 

 

 

__________________________________________________
Do You Yahoo!?
Tired of spam? Yahoo! Mail has the best spam protection around
http://mail.yahoo.com