t/handle/02_write.t

#!perl

use strict;

use AnyEvent;
BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} }
use AnyEvent::Util;
use AnyEvent::Handle;
use Socket;

print "1..7\n";

my $cv = AnyEvent->condvar;

my ($rd, $wr) = portable_socketpair;

my $rd_ae =
   AnyEvent::Handle->new (
      fh => $rd,
      on_eof => sub {
         warn "reader got EOF";
         $cv->broadcast
      }
   );

my $wr_ae =
   AnyEvent::Handle->new (
      fh => $wr,
      on_eof => sub {
         warn "writer got EOF\n";
         $cv->broadcast
      }
   );

my $dat = '';

$rd_ae->push_read (chunk => 5132, sub {
   my ($rd_ae, $data) = @_;
   $dat = substr $data, 0, 2;
   $dat .= substr $data, -5;

   print "ok 4 - first read chunk\n";
   my $n = 5;
   $wr_ae->push_write ("A" x 5000);
   $wr_ae->on_drain (sub {
      my ($wr_ae) = @_;
      $wr_ae->on_drain;
      print "ok " . $n++ . " - fourth write\n";

   });

   $rd_ae->push_read (chunk => 5000, sub {
      print "ok " . $n++ . " - second read chunk\n";
      $cv->broadcast
   });
});

$wr_ae->push_write ("A" x 5000);
$wr_ae->push_write ("X" x 130);

# and now some extreme CPS action:
$wr_ae->on_drain (sub {
   my ($wr_ae) = @_;
   $wr_ae->on_drain;
   print "ok 1 - first write\n";

   $wr_ae->push_write ("Y");
   $wr_ae->on_drain (sub {
      my ($wr_ae) = @_;
      $wr_ae->on_drain;
      print "ok 2 - second write\n";

      $wr_ae->push_write ("Z");
      $wr_ae->on_drain (sub {
         my ($wr_ae) = @_;
         $wr_ae->on_drain;
         print "ok 3 - third write\n";
      });
   });
});

$cv->wait;

if ($dat eq "AAXXXYZ") {
   print "ok 7 - received data\n";
} else {
   warn "dat was '$dat'\n";
   print "not ok 7 - received data\n";
}
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 *
#	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	}