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