view release on metacpan or  search on metacpan

t/cond.t  view on Meta::CPAN

use strict;
use warnings;

BEGIN {
    use Config;
    if (! $Config{'useithreads'}) {
        print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
        exit(0);
    }
}

use ExtUtils::testlib;

my $Base = 0;
sub ok {
    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..32\n");   ### Number of tests that will be run ###
};

use threads;
use threads::shared;
ok(1, 1, 'Loaded');
$Base++;

### Start of Testing ###

# test locking
{
    my $lock : shared;
    my $tr;

    # test that a subthread can't lock until parent thread has unlocked

    {
        lock($lock);
        ok(1, 1, "set first lock");
        $tr = async {
            lock($lock);
            ok(3, 1, "set lock in subthread");
        };
        threads->yield;
        ok(2, 1, "still got lock");
    }
    $tr->join;

    $Base += 3;

    # ditto with ref to thread

    {
        my $lockref = \$lock;
        lock($lockref);
        ok(1,1,"set first lockref");
        $tr = async {
            lock($lockref);
            ok(3,1,"set lockref in subthread");
        };
        threads->yield;
        ok(2,1,"still got lockref");
    }
    $tr->join;

    $Base += 3;

    # make sure recursive locks unlock at the right place
    {
        lock($lock);
        ok(1,1,"set first recursive lock");
        lock($lock);