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