AnyEvent/t/09_multi.t

BEGIN {
   # check for broken perls
   if ($^O =~ /mswin32/i) {
      my $ok;
      local $SIG{CHLD} = sub { $ok = 1 };
      kill 'CHLD', 0;

      unless ($ok) {
         print <<EOF;
1..0 # SKIP Your perl interpreter is badly BROKEN. Child watchers will not work, ever. Try upgrading to a newer perl or a working perl (cygwin's perl is known to work). If that is not an option, you should be able to use the remaining functionality of AnyEvent, but child watchers WILL NOT WORK.
EOF
         exit 0;
      }
   }
}

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

$| = 1; print "1..15\n";

print "ok 1\n";

my ($a, $b) = AnyEvent::Util::portable_socketpair;

# I/O write
{
   my $cv = AE::cv;
   my $wt = AE::timer 1, 0, $cv;
   my $s = 0;

   $cv->begin; my $wa = AE::io $a, 1, sub { $cv->end; $s |= 1 };
   $cv->begin; my $wb = AE::io $a, 1, sub { $cv->end; $s |= 2 };

   $cv->recv;

   print $s == 3 ? "" : "not ", "ok 2 # $s\n";
}

# I/O read
{
   my $cv = AE::cv;
   my $wt = AE::timer 0.01, 0, $cv;
   my $s = 0;

   my $wa = AE::io $a, 0, sub { $cv->end; $s |= 1 };
   my $wb = AE::io $a, 0, sub { $cv->end; $s |= 2 };

   $cv->recv;

   print $s == 0 ? "" : "not ", "ok 3 # $s\n";

   syswrite $b, "x";

   $cv = AE::cv;
   $wt = AE::timer 1, 0, $cv;

   $s = 0;
   $cv->begin;
   $cv->begin;
   $cv->recv;

   print $s == 3 ? "" : "not ", "ok 4 # $s\n";

   sysread $a, my $dummy, 1;

   $cv = AE::cv;
   $wt = AE::timer 0.01, 0, $cv;

   $s = 0;
   $cv->recv;

   print $s == 0 ? "" : "not ", "ok 5 # $s\n";
}

# signal
{
   my $cv = AE::cv;
   my $wt = AE::timer 0.01, 0, $cv;
   my $s = 0;

   $cv->begin; my $wa = AE::signal INT => sub { $cv->end; $s |= 1 };
   $cv->begin; my $wb = AE::signal INT => sub { $cv->end; $s |= 2 };

   $cv->recv;

   print $s == 0 ? "" : "not ", "ok 6 # $s\n";

   kill INT => $$;

   $cv = AE::cv;
   $wt = AE::timer 0.01, 0, $cv;

   $s = 0;
   $cv->recv;

   print $s == 3 ? "" : "not ", "ok 7 # $s\n";

   $cv = AE::cv;
   $wt = AE::timer 0.01, 0, $cv;

   $s = 0;
   $cv->recv;

   print $s == 0 ? "" : "not ", "ok 8 # $s\n";
}

$AnyEvent::MAX_SIGNAL_LATENCY = 0.2;

# child
{
   my $cv = AE::cv;
   my $wt = AE::timer 0.01, 0, $cv;
   my $s = 0;

   my $pid = fork;

   unless ($pid) {
      sleep 2;
      exit 1;
   }

   my ($apid, $bpid, $astatus, $bstatus);

   $cv->begin; my $wa = AE::child $pid, sub { ($apid, $astatus) = @_; $cv->end; $s |= 1 };
   $cv->begin; my $wb = AE::child $pid, sub { ($bpid, $bstatus) = @_; $cv->end; $s |= 2 };

   $cv->recv;

   print $s == 0 ? "" : "not ", "ok 9 # $s\n";

   kill 9, $pid;

   $cv = AE::cv;
   $wt = AE::timer 0.01, 0, $cv;

   $s = 0;
   $cv->recv;

   print $s == 3 ? "" : "not ", "ok 10 # $s\n";
   print $apid == $pid && $bpid == $pid ? "" : "not ", "ok 11 # $apid == $bpid == $pid\n";
   print $astatus == 9 && $bstatus == 9 ? "" : "not ", "ok 12 # $astatus == $bstatus == 9\n";

   $cv = AE::cv;
   $wt = AE::timer 0.01, 0, $cv;

   $s = 0;
   $cv->recv;

   print $s == 0 ? "" : "not ", "ok 13 # $s\n";
}

# timers (don't laugh, some event loops are more broken...)
{
   my $cv = AE::cv;
   my $wt = AE::timer 1, 0, $cv;
   my $s = 0;

   $cv->begin; my $wa = AE::timer 0   , 0, sub { $cv->end; $s |= 1 };
   $cv->begin; my $wb = AE::timer 0   , 0, sub { $cv->end; $s |= 2 };
   $cv->begin; my $wc = AE::timer 0.01, 0, sub { $cv->end; $s |= 4 };

   $cv->recv;

   print $s == 7 ? "" : "not ", "ok 14 # $s\n";
}

print "ok 15\n";

exit 0;

Revision:	1.5
Committed:	Fri Aug 12 18:41:26 2011 UTC (13 years, 3 months ago) by root
Content type:	application/x-troff
Branch:	MAIN
CVS Tags:	rel-6_0
Changes since 1.4:	+8 -8 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.3	BEGIN {
2			# check for broken perls
3			if ($^O =~ /mswin32/i) {
4			my $ok;
5			local $SIG{CHLD} = sub { $ok = 1 };
6			kill 'CHLD', 0;
7
8			unless ($ok) {
9			print <<EOF;
10			1..0 # SKIP Your perl interpreter is badly BROKEN. Child watchers will not work, ever. Try upgrading to a newer perl or a working perl (cygwin's perl is known to work). If that is not an option, you should be able to use the remaining functionality of AnyEvent, but child watchers WILL NOT WORK.
11			EOF
12			exit 0;
13			}
14			}
15			}
16
17	root	1.1	use AnyEvent;
18			use AnyEvent::Util;
19			BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} }
20
21	root	1.4	$\| = 1; print "1..15\n";
22	root	1.1
23			print "ok 1\n";
24
25			my ($a, $b) = AnyEvent::Util::portable_socketpair;
26
27			# I/O write
28			{
29			my $cv = AE::cv;
30	root	1.4	my $wt = AE::timer 1, 0, $cv;
31	root	1.1	my $s = 0;
32
33			$cv->begin; my $wa = AE::io $a, 1, sub { $cv->end; $s \|= 1 };
34			$cv->begin; my $wb = AE::io $a, 1, sub { $cv->end; $s \|= 2 };
35
36			$cv->recv;
37
38			print $s == 3 ? "" : "not ", "ok 2 # $s\n";
39			}
40
41			# I/O read
42			{
43			my $cv = AE::cv;
44	root	1.5	my $wt = AE::timer 0.01, 0, $cv;
45	root	1.1	my $s = 0;
46
47	root	1.2	my $wa = AE::io $a, 0, sub { $cv->end; $s \|= 1 };
48			my $wb = AE::io $a, 0, sub { $cv->end; $s \|= 2 };
49	root	1.1
50			$cv->recv;
51
52			print $s == 0 ? "" : "not ", "ok 3 # $s\n";
53
54			syswrite $b, "x";
55
56			$cv = AE::cv;
57	root	1.4	$wt = AE::timer 1, 0, $cv;
58	root	1.1
59			$s = 0;
60	root	1.2	$cv->begin;
61			$cv->begin;
62	root	1.1	$cv->recv;
63
64			print $s == 3 ? "" : "not ", "ok 4 # $s\n";
65
66			sysread $a, my $dummy, 1;
67
68			$cv = AE::cv;
69	root	1.5	$wt = AE::timer 0.01, 0, $cv;
70	root	1.1
71			$s = 0;
72			$cv->recv;
73
74			print $s == 0 ? "" : "not ", "ok 5 # $s\n";
75			}
76
77			# signal
78			{
79			my $cv = AE::cv;
80	root	1.5	my $wt = AE::timer 0.01, 0, $cv;
81	root	1.1	my $s = 0;
82
83			$cv->begin; my $wa = AE::signal INT => sub { $cv->end; $s \|= 1 };
84			$cv->begin; my $wb = AE::signal INT => sub { $cv->end; $s \|= 2 };
85
86			$cv->recv;
87
88			print $s == 0 ? "" : "not ", "ok 6 # $s\n";
89
90			kill INT => $$;
91
92			$cv = AE::cv;
93	root	1.5	$wt = AE::timer 0.01, 0, $cv;
94	root	1.1
95			$s = 0;
96			$cv->recv;
97
98			print $s == 3 ? "" : "not ", "ok 7 # $s\n";
99
100			$cv = AE::cv;
101	root	1.5	$wt = AE::timer 0.01, 0, $cv;
102	root	1.1
103			$s = 0;
104			$cv->recv;
105
106			print $s == 0 ? "" : "not ", "ok 8 # $s\n";
107			}
108
109			$AnyEvent::MAX_SIGNAL_LATENCY = 0.2;
110
111			# child
112			{
113			my $cv = AE::cv;
114	root	1.5	my $wt = AE::timer 0.01, 0, $cv;
115	root	1.1	my $s = 0;
116
117			my $pid = fork;
118
119			unless ($pid) {
120			sleep 2;
121			exit 1;
122			}
123
124			my ($apid, $bpid, $astatus, $bstatus);
125
126			$cv->begin; my $wa = AE::child $pid, sub { ($apid, $astatus) = @_; $cv->end; $s \|= 1 };
127			$cv->begin; my $wb = AE::child $pid, sub { ($bpid, $bstatus) = @_; $cv->end; $s \|= 2 };
128
129			$cv->recv;
130
131			print $s == 0 ? "" : "not ", "ok 9 # $s\n";
132
133			kill 9, $pid;
134
135			$cv = AE::cv;
136	root	1.5	$wt = AE::timer 0.01, 0, $cv;
137	root	1.1
138			$s = 0;
139			$cv->recv;
140
141			print $s == 3 ? "" : "not ", "ok 10 # $s\n";
142			print $apid == $pid && $bpid == $pid ? "" : "not ", "ok 11 # $apid == $bpid == $pid\n";
143			print $astatus == 9 && $bstatus == 9 ? "" : "not ", "ok 12 # $astatus == $bstatus == 9\n";
144
145			$cv = AE::cv;
146	root	1.5	$wt = AE::timer 0.01, 0, $cv;
147	root	1.1
148			$s = 0;
149			$cv->recv;
150
151			print $s == 0 ? "" : "not ", "ok 13 # $s\n";
152			}
153
154	root	1.4	# timers (don't laugh, some event loops are more broken...)
155			{
156			my $cv = AE::cv;
157			my $wt = AE::timer 1, 0, $cv;
158			my $s = 0;
159
160			$cv->begin; my $wa = AE::timer 0 , 0, sub { $cv->end; $s \|= 1 };
161			$cv->begin; my $wb = AE::timer 0 , 0, sub { $cv->end; $s \|= 2 };
162			$cv->begin; my $wc = AE::timer 0.01, 0, sub { $cv->end; $s \|= 4 };
163
164			$cv->recv;
165
166			print $s == 7 ? "" : "not ", "ok 14 # $s\n";
167			}
168
169			print "ok 15\n";
170	root	1.1
171			exit 0;
172