t/handle/02_write.t

#!perl

use strict;

use AnyEvent::Impl::Perl;
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.8
Committed:	Fri Jul 4 12:21:58 2008 UTC (16 years ago) by elmex
Content type:	application/x-troff
Branch:	MAIN
CVS Tags:	rel-4_91, rel-4_23, rel-4_21, rel-4_412, rel-4_81, rel-4_83, rel-4_82, rel-4_86, rel-4_352, rel-5_112, rel-4_351, rel-5_251, rel-0_85, rel-4_331, rel-4_231, rel-4_233, rel-4_232, rel-4_8, rel-4_234, rel-4_4, rel-5_261, rel-5_271, rel-5_28, rel-5_29, rel-5_21, rel-5_22, rel-5_23, rel-5_24, rel-5_26, rel-5_27, rel-5_1, rel-5_0, rel-5_2, rel-4_22, rel-5_201, rel-5_202, rel-4_161, rel-5_111, rel-4_881, rel-4_411, rel-4_9, rel-5_01, rel-4_45, rel-4_41, rel-4_42, rel-4_2, rel-4_88, rel-4_3, rel-5_11, rel-5_12, rel-4_31, rel-4_32, rel-4_33, rel-4_34, rel-4_35
Changes since 1.7:	+1 -1 lines
Log Message:	....
#	Content
1	#!perl
2
3	use strict;
4
5	use AnyEvent::Impl::Perl;
6	use AnyEvent::Handle;
7	use Socket;
8
9	print "1..7\n";
10
11	my $cv = AnyEvent->condvar;
12
13	socketpair my $rd, my $wr, AF_UNIX, SOCK_STREAM, PF_UNSPEC;
14
15	my $rd_ae =
16	AnyEvent::Handle->new (
17	fh => $rd,
18	on_eof => sub {
19	warn "reader got EOF";
20	$cv->broadcast
21	}
22	);
23
24	my $wr_ae =
25	AnyEvent::Handle->new (
26	fh => $wr,
27	on_eof => sub {
28	warn "writer got EOF\n";
29	$cv->broadcast
30	}
31	);
32
33	my $dat = '';
34
35	$rd_ae->push_read (chunk => 5132, sub {
36	my ($rd_ae, $data) = @_;
37	$dat = substr $data, 0, 2;
38	$dat .= substr $data, -5;
39
40	print "ok 4 - first read chunk\n";
41	my $n = 5;
42	$wr_ae->push_write ("A" x 5000);
43	$wr_ae->on_drain (sub {
44	my ($wr_ae) = @_;
45	$wr_ae->on_drain;
46	print "ok " . $n++ . " - fourth write\n";
47
48	});
49
50	$rd_ae->push_read (chunk => 5000, sub {
51	print "ok " . $n++ . " - second read chunk\n";
52	$cv->broadcast
53	});
54	});
55
56	$wr_ae->push_write ("A" x 5000);
57	$wr_ae->push_write ("X" x 130);
58
59	# and now some extreme CPS action:
60	$wr_ae->on_drain (sub {
61	my ($wr_ae) = @_;
62	$wr_ae->on_drain;
63	print "ok 1 - first write\n";
64
65	$wr_ae->push_write ("Y");
66	$wr_ae->on_drain (sub {
67	my ($wr_ae) = @_;
68	$wr_ae->on_drain;
69	print "ok 2 - second write\n";
70
71	$wr_ae->push_write ("Z");
72	$wr_ae->on_drain (sub {
73	my ($wr_ae) = @_;
74	$wr_ae->on_drain;
75	print "ok 3 - third write\n";
76	});
77	});
78	});
79
80	$cv->wait;
81
82	if ($dat eq "AAXXXYZ") {
83	print "ok 7 - received data\n";
84	} else {
85	warn "dat was '$dat'\n";
86	print "not ok 7 - received data\n";
87	}