-# cond_wait and cond_timedwait extended tests
-# adapted from cond.t
-
+use strict;
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;
+ if ($ENV{'PERL_CORE'}){
+ chdir 't';
+ unshift @INC, '../lib';
+ }
+ use Config;
+ if (! $Config{'useithreads'}) {
+ print("1..0 # Skip: Perl not compiled with 'useithreads'\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";
+ my ($id, $ok, $name) = @_;
+ $id += $Base;
+
+ # You have to do it this way or VMS will get confused.
+ if ($ok) {
+ print("ok $id - $name\n");
+ } else {
+ print("not ok $id - $name\n");
+ printf("# Failed test at line %d\n", (caller)[2]);
+ }
+
+ return ($ok);
}
+BEGIN {
+ $| = 1;
+ print("1..103\n"); ### Number of tests that will be run ###
+};
+
+use threads;
+use threads::shared;
+ok(1, 1, 'Loaded');
+$Base++;
+
+### Start of Testing ###
+
+# cond_wait and cond_timedwait extended tests adapted from cond.t
+
+# The two skips later on in these tests refer to this quote from the
+# pod/perl583delta.pod:
+#
+# =head1 Platform Specific Problems
+#
+# The regression test ext/threads/shared/t/wait.t fails on early RedHat 9
+# and HP-UX 10.20 due to bugs in their threading implementations.
+# 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.
my $cond : shared;
my $lock : shared;
- print "# testing my \$var : shared\n";
ok(1, 1, "Shared synchronization tests preparation");
$Base += 1;
# 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;
- 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";
+ if ($^O eq "hpux" && $Config{osvers} <= 10.20) {
+ # The lock obtaining would pass, but the wait will not.
+ ok(1,1, "$test: obtained initial lock");
+ ok(2,0, "# SKIP see perl583delta");
+ } else {
+ $test =~ /twain/ ? lock($lock) : lock($cond);
+ ok(1,1, "$test: obtained initial lock");
+ my $ok;
+ 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");
}
- ok(2,!defined($ok), "$test: timeout");
}
} # -- SYNCH_SHARED block
my $cond = \$true_cond;
my $lock = \$true_lock;
- print "# testing reference to shared(\$var)\n";
ok(1, 1, "Synchronization reference tests preparation");
$Base += 1;
sub ctw_fail2 {
my $to = shift;
- $test =~ /twain/ ? lock($lock) : lock($cond);
- ok(1,1, "$test: obtained initial lock");
- my $ok;
- 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";
+ if ($^O eq "hpux" && $Config{osvers} <= 10.20) {
+ # The lock obtaining would pass, but the wait will not.
+ ok(1,1, "$test: obtained initial lock");
+ ok(2,0, "# SKIP see perl583delta");
+ } else {
+ $test =~ /twain/ ? lock($lock) : lock($cond);
+ ok(1,1, "$test: obtained initial lock");
+ my $ok;
+ 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,!$ok, "$test: timeout");
}
- ok(2,!$ok, "$test: timeout");
}
} # -- SYNCH_REFS block
+# EOF