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
|
#!perl
use strict;
use AnyEvent;
BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} }
use AnyEvent::Util;
use AnyEvent::Handle;
use Socket;
print "1..7\n";
my $cv = AnyEvent->condvar;
my ($rd, $wr) = portable_socketpair;
my $rd_ae =
AnyEvent::Handle->new (
fh => $rd,
on_eof => sub {
warn "reader got EOF";
$cv->broadcast
}
);
my $wr_ae =
AnyEvent::Handle->new (
fh => $wr,
on_eof => sub {
warn "writer got EOF\n";
$cv->broadcast
}
);
my $dat = '';
$rd_ae->push_read (chunk => 5132, sub {
my ($rd_ae, $data) = @_;
$dat = substr $data, 0, 2;
$dat .= substr $data, -5;
print "ok 4 - first read chunk\n";
my $n = 5;
$wr_ae->push_write ("A" x 5000);
$wr_ae->on_drain (sub {
my ($wr_ae) = @_;
$wr_ae->on_drain;
print "ok " . $n++ . " - fourth write\n";
});
$rd_ae->push_read (chunk => 5000, sub {
print "ok " . $n++ . " - second read chunk\n";
$cv->broadcast
});
});
$wr_ae->push_write ("A" x 5000);
$wr_ae->push_write ("X" x 130);
# and now some extreme CPS action:
$wr_ae->on_drain (sub {
my ($wr_ae) = @_;
$wr_ae->on_drain;
print "ok 1 - first write\n";
$wr_ae->push_write ("Y");
$wr_ae->on_drain (sub {
my ($wr_ae) = @_;
$wr_ae->on_drain;
print "ok 2 - second write\n";
$wr_ae->push_write ("Z");
$wr_ae->on_drain (sub {
my ($wr_ae) = @_;
$wr_ae->on_drain;
print "ok 3 - third write\n";
});
});
});
$cv->wait;
if ($dat eq "AAXXXYZ") {
print "ok 7 - received data\n";
} else {
warn "dat was '$dat'\n";
print "not ok 7 - received data\n";
}
|
