view release on metacpan or  search on metacpan

t/02_rw_mutex.t  view on Meta::CPAN

#!/usr/bin/perl

use warnings;
use strict;
use utf8;
use open qw(:std :utf8);
use lib qw(lib ../lib);

use Test::More tests    => 8;
use Encode qw(decode encode);
use Time::HiRes qw(time);


BEGIN {
    # Подготовка объекта тестирования для работы с utf8
    my $builder = Test::More->builder;
    binmode $builder->output,         ":utf8";
    binmode $builder->failure_output, ":utf8";
    binmode $builder->todo_output,    ":utf8";

    use_ok 'AnyEvent';
    use_ok 'AnyEvent::Tools', ':mutex';
}

{
    my $mutex = rw_mutex;
    my $cv = condvar AnyEvent;

    my $counter = 0;
    my $done_counter = 0;
    my $timer;

    $timer = AE::timer 0.13, 0 => sub { $cv->send };

    $mutex->rlock(sub {
        my ($g) = @_;
        my $t;
        my $mcounter = 0;

        $t = AE::timer 0.01, 0.01 => sub {
            $mcounter++;
            if ($mcounter++ >= 10) {
                undef $t;
                undef $g;
                $done_counter++;
                $cv->send if $done_counter == 2;
                return;
            }
            $counter++;
        };
    });

    $mutex->rlock(sub {
        my ($g) = @_;
        my $t;
        my $mcounter = 0;

        $t = AE::timer 0.01, 0.01 => sub {
            $mcounter++;
            if ($mcounter++ >= 10) {
                undef $t;
                undef $g;
                $done_counter++;
                $cv->send if $done_counter == 2;
                return;
            }
            $counter++;