t/handle/02_write.t

#!perl

use strict;

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

print "1..7\n";

my $cv = AnyEvent->condvar;

socketpair my $rd, my $wr, AF_UNIX, SOCK_STREAM, PF_UNSPEC;

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.9
Committed:	Wed Dec 29 04:16:34 2010 UTC (13 years, 6 months ago) by root
Content type:	application/x-troff
Branch:	MAIN
CVS Tags:	rel-6_0, rel-5_3, rel-5_31
Changes since 1.8:	+2 -1 lines
Log Message:	first round of ioasync rewrite
#	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::Handle;
8	use Socket;
9
10	print "1..7\n";
11
12	my $cv = AnyEvent->condvar;
13
14	socketpair my $rd, my $wr, AF_UNIX, SOCK_STREAM, PF_UNSPEC;
15
16	my $rd_ae =
17	AnyEvent::Handle->new (
18	fh => $rd,
19	on_eof => sub {
20	warn "reader got EOF";
21	$cv->broadcast
22	}
23	);
24
25	my $wr_ae =
26	AnyEvent::Handle->new (
27	fh => $wr,
28	on_eof => sub {
29	warn "writer got EOF\n";
30	$cv->broadcast
31	}
32	);
33
34	my $dat = '';
35
36	$rd_ae->push_read (chunk => 5132, sub {
37	my ($rd_ae, $data) = @_;
38	$dat = substr $data, 0, 2;
39	$dat .= substr $data, -5;
40
41	print "ok 4 - first read chunk\n";
42	my $n = 5;
43	$wr_ae->push_write ("A" x 5000);
44	$wr_ae->on_drain (sub {
45	my ($wr_ae) = @_;
46	$wr_ae->on_drain;
47	print "ok " . $n++ . " - fourth write\n";
48
49	});
50
51	$rd_ae->push_read (chunk => 5000, sub {
52	print "ok " . $n++ . " - second read chunk\n";
53	$cv->broadcast
54	});
55	});
56
57	$wr_ae->push_write ("A" x 5000);
58	$wr_ae->push_write ("X" x 130);
59
60	# and now some extreme CPS action:
61	$wr_ae->on_drain (sub {
62	my ($wr_ae) = @_;
63	$wr_ae->on_drain;
64	print "ok 1 - first write\n";
65
66	$wr_ae->push_write ("Y");
67	$wr_ae->on_drain (sub {
68	my ($wr_ae) = @_;
69	$wr_ae->on_drain;
70	print "ok 2 - second write\n";
71
72	$wr_ae->push_write ("Z");
73	$wr_ae->on_drain (sub {
74	my ($wr_ae) = @_;
75	$wr_ae->on_drain;
76	print "ok 3 - third write\n";
77	});
78	});
79	});
80
81	$cv->wait;
82
83	if ($dat eq "AAXXXYZ") {
84	print "ok 7 - received data\n";
85	} else {
86	warn "dat was '$dat'\n";
87	print "not ok 7 - received data\n";
88	}