| 1 | #!perl |
1 | #!perl |
|
|
2 | |
| 2 | use strict; |
3 | use strict; |
|
|
4 | |
|
|
5 | use AnyEvent; |
|
|
6 | BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} } |
| 3 | use AnyEvent::Handle; |
7 | use AnyEvent::Handle; |
| 4 | use Test::More tests => 2; |
|
|
| 5 | use Socket; |
8 | use Socket; |
|
|
9 | |
|
|
10 | print "1..7\n"; |
| 6 | |
11 | |
| 7 | my $cv = AnyEvent->condvar; |
12 | my $cv = AnyEvent->condvar; |
| 8 | |
13 | |
| 9 | socketpair my $rd, my $wr, AF_UNIX, SOCK_STREAM, PF_UNSPEC; |
14 | socketpair my $rd, my $wr, AF_UNIX, SOCK_STREAM, PF_UNSPEC; |
| 10 | |
15 | |
| 11 | my $rd_ae = AnyEvent::Handle->new (fh => $rd); |
16 | my $rd_ae = |
|
|
17 | AnyEvent::Handle->new ( |
|
|
18 | fh => $rd, |
|
|
19 | on_eof => sub { |
|
|
20 | warn "reader got EOF"; |
|
|
21 | $cv->broadcast |
|
|
22 | } |
|
|
23 | ); |
|
|
24 | |
|
|
25 | my $wr_ae = |
|
|
26 | AnyEvent::Handle->new ( |
|
|
27 | fh => $wr, |
|
|
28 | on_eof => sub { |
|
|
29 | warn "writer got EOF\n"; |
|
|
30 | $cv->broadcast |
|
|
31 | } |
|
|
32 | ); |
| 12 | |
33 | |
| 13 | my $dat = ''; |
34 | my $dat = ''; |
| 14 | my $write_cb_called = 0; |
|
|
| 15 | |
35 | |
| 16 | $rd_ae->read (5132, sub { |
36 | $rd_ae->push_read (chunk => 5132, sub { |
| 17 | my ($rd_ae, $data) = @_; |
37 | my ($rd_ae, $data) = @_; |
| 18 | $dat = substr $data, 0, 2; |
38 | $dat = substr $data, 0, 2; |
| 19 | $dat .= substr $data, -5; |
39 | $dat .= substr $data, -5; |
| 20 | $rd_ae->read (1, sub { $cv->broadcast }); |
40 | |
|
|
41 | print "ok 4 - first read chunk\n"; |
|
|
42 | my $n = 5; |
|
|
43 | $wr_ae->push_write ("A" x 5000); |
|
|
44 | $wr_ae->on_drain (sub { |
|
|
45 | my ($wr_ae) = @_; |
|
|
46 | $wr_ae->on_drain; |
|
|
47 | print "ok " . $n++ . " - fourth write\n"; |
|
|
48 | |
|
|
49 | }); |
|
|
50 | |
|
|
51 | $rd_ae->push_read (chunk => 5000, sub { |
|
|
52 | print "ok " . $n++ . " - second read chunk\n"; |
|
|
53 | $cv->broadcast |
|
|
54 | }); |
| 21 | }); |
55 | }); |
| 22 | |
56 | |
| 23 | my $wr_ae = AnyEvent::Handle->new (fh => $wr); |
57 | $wr_ae->push_write ("A" x 5000); |
|
|
58 | $wr_ae->push_write ("X" x 130); |
| 24 | |
59 | |
| 25 | $wr_ae->write ("A" x 5000); |
60 | # and now some extreme CPS action: |
| 26 | $wr_ae->write (("X" x 130), sub { $write_cb_called++; }); |
61 | $wr_ae->on_drain (sub { |
| 27 | $wr_ae->write ("Y", sub { $write_cb_called++; }); |
62 | my ($wr_ae) = @_; |
|
|
63 | $wr_ae->on_drain; |
|
|
64 | print "ok 1 - first write\n"; |
|
|
65 | |
| 28 | $wr_ae->write ("Z"); |
66 | $wr_ae->push_write ("Y"); |
| 29 | $wr_ae->write (sub { $write_cb_called++; }); |
67 | $wr_ae->on_drain (sub { |
| 30 | $wr_ae->write ("A" x 5000); |
68 | my ($wr_ae) = @_; |
| 31 | $wr_ae->write (sub { $write_cb_called++ }); |
69 | $wr_ae->on_drain; |
|
|
70 | print "ok 2 - second write\n"; |
|
|
71 | |
|
|
72 | $wr_ae->push_write ("Z"); |
|
|
73 | $wr_ae->on_drain (sub { |
|
|
74 | my ($wr_ae) = @_; |
|
|
75 | $wr_ae->on_drain; |
|
|
76 | print "ok 3 - third write\n"; |
|
|
77 | }); |
|
|
78 | }); |
|
|
79 | }); |
| 32 | |
80 | |
| 33 | $cv->wait; |
81 | $cv->wait; |
| 34 | |
82 | |
| 35 | is ($dat, "AAXXXYZ", 'lines were read and written correctly'); |
83 | if ($dat eq "AAXXXYZ") { |
| 36 | is ($write_cb_called, 4, 'write callbacks called correctly'); |
84 | print "ok 7 - received data\n"; |
|
|
85 | } else { |
|
|
86 | warn "dat was '$dat'\n"; |
|
|
87 | print "not ok 7 - received data\n"; |
|
|
88 | } |
