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 *** |
# | 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 | } |