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
|
#!/usr/bin/perl
use warnings;
use strict;
use utf8;
use open qw(:std :utf8);
use lib qw(lib ../lib);
use Test::More tests => 28;
use Encode qw(decode encode);
BEGIN {
# Подготовка объекта тестирования для работы с utf8
my $builder = Test::More->builder;
binmode $builder->output, ":utf8";
binmode $builder->failure_output, ":utf8";
binmode $builder->todo_output, ":utf8";
use_ok 'AnyEvent::Callback';
use_ok 'AnyEvent';
}
for my $cv (AE::cv) {
my @res;
my $cbs = CBS;
$cbs->wait(sub { @res = @_; $cv->send });
$cv->recv;
cmp_ok scalar(@res), '~~', 0, 'empty list';
}
for my $cv (AE::cv) {
my @res;
my $cbs = CBS;
my @timers;
for (1 .. 10) {
push @timers => AE::timer rand .1, 0, $cbs->cb;
}
push @timers => AE::timer 0, 0, $cbs->cb;
$cbs->wait(sub { @res = @_; $cv->send });
{
$cbs->cb;
}
$cv->recv;
cmp_ok scalar(@res), '~~', 12, 'stack list';
for (0 .. $#res) {
isa_ok $res[$_] => 'AnyEvent::Callback::Stack::Result';
if ($_ < $#res) {
ok !$res[$_]->is_error, 'not error' ;
} else {
ok $res[$_]->is_error, 'forgotten callback';
}
}
}
|
