| Revision: | 1.10 |
| Committed: | Fri Aug 26 03:34:02 2011 UTC (15 years, 2 months ago) by root |
| Content type: | application/x-troff |
| Branch: | MAIN |
| CVS Tags: | rel-7_05, rel-7_07, rel-7_01, rel-7_02, rel-7_03, rel-7_08, rel-7_09, rel-7_16, rel-7_13, rel-7_11, rel-6_1, rel-6_11, rel-6_12, rel-6_13, rel-7_15, rel-7_14, rel-7_12, rel-6_02, rel-6_01, rel-7_0, rel-7_04, rel-6_14, HEAD |
| Changes since 1.9: | +2 -1 lines |
| Log Message: | *** empty log message *** |
| # | User | Rev | Content |
|---|---|---|---|
| 1 | elmex | 1.1 | #!perl |
| 2 | root | 1.5 | |
| 3 | elmex | 1.1 | use strict; |
| 4 | root | 1.5 | |
| 5 | root | 1.9 | use AnyEvent; |
| 6 | BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} } | ||
| 7 | root | 1.10 | use AnyEvent::Util; |
| 8 | elmex | 1.1 | use AnyEvent::Handle; |
| 9 | use Socket; | ||
| 10 | |||
| 11 | elmex | 1.3 | print "1..7\n"; |
| 12 | |||
| 13 | elmex | 1.1 | my $cv = AnyEvent->condvar; |
| 14 | |||
| 15 | root | 1.10 | my ($rd, $wr) = portable_socketpair; |
| 16 | elmex | 1.1 | |
| 17 | elmex | 1.3 | my $rd_ae = |
| 18 | AnyEvent::Handle->new ( | ||
| 19 | fh => $rd, | ||
| 20 | on_eof => sub { | ||
| 21 | warn "reader got EOF"; | ||
| 22 | $cv->broadcast | ||
| 23 | } | ||
| 24 | ); | ||
| 25 | |||
| 26 | my $wr_ae = | ||
| 27 | AnyEvent::Handle->new ( | ||
| 28 | fh => $wr, | ||
| 29 | on_eof => sub { | ||
| 30 | warn "writer got EOF\n"; | ||
| 31 | $cv->broadcast | ||
| 32 | } | ||
| 33 | ); | ||
| 34 | elmex | 1.1 | |
| 35 | my $dat = ''; | ||
| 36 | |||
| 37 | root | 1.6 | $rd_ae->push_read (chunk => 5132, sub { |
| 38 | elmex | 1.1 | my ($rd_ae, $data) = @_; |
| 39 | $dat = substr $data, 0, 2; | ||
| 40 | $dat .= substr $data, -5; | ||
| 41 | elmex | 1.3 | |
| 42 | print "ok 4 - first read chunk\n"; | ||
| 43 | elmex | 1.7 | my $n = 5; |
| 44 | elmex | 1.3 | $wr_ae->push_write ("A" x 5000); |
| 45 | $wr_ae->on_drain (sub { | ||
| 46 | my ($wr_ae) = @_; | ||
| 47 | $wr_ae->on_drain; | ||
| 48 | elmex | 1.7 | print "ok " . $n++ . " - fourth write\n"; |
| 49 | elmex | 1.3 | |
| 50 | elmex | 1.7 | }); |
| 51 | |||
| 52 | elmex | 1.8 | $rd_ae->push_read (chunk => 5000, sub { |
| 53 | elmex | 1.7 | print "ok " . $n++ . " - second read chunk\n"; |
| 54 | $cv->broadcast | ||
| 55 | elmex | 1.3 | }); |
| 56 | elmex | 1.1 | }); |
| 57 | |||
| 58 | elmex | 1.3 | $wr_ae->push_write ("A" x 5000); |
| 59 | $wr_ae->push_write ("X" x 130); | ||
| 60 | elmex | 1.1 | |
| 61 | elmex | 1.3 | # and now some extreme CPS action: |
| 62 | $wr_ae->on_drain (sub { | ||
| 63 | my ($wr_ae) = @_; | ||
| 64 | $wr_ae->on_drain; | ||
| 65 | print "ok 1 - first write\n"; | ||
| 66 | |||
| 67 | $wr_ae->push_write ("Y"); | ||
| 68 | $wr_ae->on_drain (sub { | ||
| 69 | my ($wr_ae) = @_; | ||
| 70 | $wr_ae->on_drain; | ||
| 71 | print "ok 2 - second write\n"; | ||
| 72 | |||
| 73 | $wr_ae->push_write ("Z"); | ||
| 74 | $wr_ae->on_drain (sub { | ||
| 75 | my ($wr_ae) = @_; | ||
| 76 | $wr_ae->on_drain; | ||
| 77 | print "ok 3 - third write\n"; | ||
| 78 | }); | ||
| 79 | }); | ||
| 80 | }); | ||
| 81 | elmex | 1.1 | |
| 82 | $cv->wait; | ||
| 83 | |||
| 84 | elmex | 1.3 | if ($dat eq "AAXXXYZ") { |
| 85 | print "ok 7 - received data\n"; | ||
| 86 | } else { | ||
| 87 | warn "dat was '$dat'\n"; | ||
| 88 | print "not ok 7 - received data\n"; | ||
| 89 | } |