Revision: | 1.10 |
Committed: | Fri Aug 26 03:34:02 2011 UTC (12 years, 11 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 *** |
# | Content |
---|---|
1 | #!perl |
2 | |
3 | use strict; |
4 | |
5 | use AnyEvent; |
6 | BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} } |
7 | use AnyEvent::Util; |
8 | use AnyEvent::Handle; |
9 | use Socket; |
10 | |
11 | print "1..7\n"; |
12 | |
13 | my $cv = AnyEvent->condvar; |
14 | |
15 | my ($rd, $wr) = portable_socketpair; |
16 | |
17 | 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 | |
35 | my $dat = ''; |
36 | |
37 | $rd_ae->push_read (chunk => 5132, sub { |
38 | my ($rd_ae, $data) = @_; |
39 | $dat = substr $data, 0, 2; |
40 | $dat .= substr $data, -5; |
41 | |
42 | print "ok 4 - first read chunk\n"; |
43 | my $n = 5; |
44 | $wr_ae->push_write ("A" x 5000); |
45 | $wr_ae->on_drain (sub { |
46 | my ($wr_ae) = @_; |
47 | $wr_ae->on_drain; |
48 | print "ok " . $n++ . " - fourth write\n"; |
49 | |
50 | }); |
51 | |
52 | $rd_ae->push_read (chunk => 5000, sub { |
53 | print "ok " . $n++ . " - second read chunk\n"; |
54 | $cv->broadcast |
55 | }); |
56 | }); |
57 | |
58 | $wr_ae->push_write ("A" x 5000); |
59 | $wr_ae->push_write ("X" x 130); |
60 | |
61 | # 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 | |
82 | $cv->wait; |
83 | |
84 | 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 | } |