view release on metacpan or  search on metacpan

t/wait.t  view on Meta::CPAN

use strict;
use warnings;

BEGIN {
    # Import test.pl into its own package
    {
        package Test;
        require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl');
    }

    use Config;
    if (! $Config{'useithreads'}) {
        Test::skip_all(q/Perl not compiled with 'useithreads'/);
    }
}

use ExtUtils::testlib;

sub ok {
    my ($id, $ok, $name) = @_;

    # 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..91\n");   ### Number of tests that will be run ###
};

use threads;
use threads::shared;

Test::watchdog(300);   # In case we get stuck

my $TEST = 1;
ok($TEST++, 1, 'Loaded');

### 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.


# - TEST basics

ok($TEST++, defined &cond_wait, "cond_wait() present");
ok($TEST++, (prototype(\&cond_wait) eq '\[$@%];\[$@%]'),
                q/cond_wait() prototype '\[$@%];\[$@%]'/);
ok($TEST++, defined &cond_timedwait, "cond_timedwait() present");
ok($TEST++, (prototype(\&cond_timedwait) eq '\[$@%]$;\[$@%]'),
                q/cond_timedwait() prototype '\[$@%]$;\[$@%]'/);


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_type :shared;   # simple|repeat|twain

    my $cond :shared;
    my $lock :shared;

    ok($TEST++, 1, "Shared synchronization tests preparation");

    sub signaller
    {