1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
#!/usr/bin/perl
use warnings;
use strict;
use utf8;
use open qw(:std :utf8);
use lib qw(lib ../lib);
use Test::More tests => 6;
use Time::HiRes qw(time);
use Encode qw(decode encode);
use AnyEvent;
BEGIN {
my $builder = Test::More->builder;
binmode $builder->output, ":utf8";
binmode $builder->failure_output, ":utf8";
binmode $builder->todo_output, ":utf8";
use_ok 'AnyEvent::Tools', 'pool';
}
{
my $cv = condvar AnyEvent;
my $pool = pool qw( a b );
my $order = 0;
my @res;
my $busy = 0;
my $cnt = 1;
my $idle;
$idle = AE::idle sub {
$pool->get(sub {
my ($guard, $object) = @_;
$busy++;
push @res, { b => $busy, t => time };
my $timer;
$timer = AE::timer 0.1, 0 => sub {
$busy--;
undef $timer;
undef $guard;
if (@res >= 40) {
undef $idle;
$cv->send;
}
};
});
undef $idle if $cnt++ >= 40;
};
$cv->recv;
my $ok;
for (my $i = 0 ; $i < @res - 2; $i += 2) {
$ok = $res[$i + 2]{t} - $res[$i]{t} >= .09;
last unless $ok;
}
diag explain \@res unless
ok $ok, "Sequence order is right";
ok 0 == grep({ $_->{b} > 2 } @res), "Pool works fine";
}
{
my $cv = condvar AnyEvent;
my $pool = pool qw( a b );
my $order = 0;
my @res;
my $dtime = 0;
my $ano = $pool->push('c');
my $t;
$t = AE::timer 0.7, 0 => sub {
$pool->delete($ano => sub { $dtime = time });
undef $t;
};
for (0 .. 10) {
$pool->get(sub {
my ($guard, $object) = @_;
my $timer;
$timer = AE::timer 0.5, 0 => sub {
push @res, { obj => $object, time => time, order => $order++ };
undef $timer;
undef $guard;
$cv->send if @res == 11;
};
});
}
$cv->recv;
ok 2 == grep({ $_->{obj} eq 'c' } @res), "delete method works fine";
my ($f, $s) = grep { $_->{obj} eq 'c' } @res;
diag explain \@res unless
ok $s->{time} - $f->{time} >= 0.45, "Sequence order is right";
ok $dtime - $f->{time} >= 0.45, "delete only if resource free";
}
|
