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;
      }
   }
}

$^W = 0; # 5.8.6 bugs

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

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

print "ok 1\n";

$AnyEvent::MAX_SIGNAL_LATENCY = 0.05;

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.2, 0, $cv; # maybe OS X needs more time here? or maybe some buggy arm kernel?

   $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";
}

# 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.2, 0, $cv; # cygwin needs ages for this

   $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.9
Committed:	Sat Oct 1 22:48:36 2011 UTC (13 years, 2 months ago) by root
Content type:	application/x-troff
Branch:	MAIN
CVS Tags:	rel-7_0, rel-6_1, rel-6_14, rel-6_11, rel-6_12, rel-6_13, rel-7_04, 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_15, rel-7_14, rel-7_13, rel-7_12, rel-7_11, HEAD
Changes since 1.8:	+1 -1 lines
Log Message:	* empty log message *
#	Content
1	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	$^W = 0; # 5.8.6 bugs
18
19	use AnyEvent;
20	use AnyEvent::Util;
21	BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} }
22
23	$\| = 1; print "1..15\n";
24
25	print "ok 1\n";
26
27	$AnyEvent::MAX_SIGNAL_LATENCY = 0.05;
28
29	my ($a, $b) = AnyEvent::Util::portable_socketpair;
30
31	# I/O write
32	{
33	my $cv = AE::cv;
34	my $wt = AE::timer 1, 0, $cv;
35	my $s = 0;
36
37	$cv->begin; my $wa = AE::io $a, 1, sub { $cv->end; $s \|= 1 };
38	$cv->begin; my $wb = AE::io $a, 1, sub { $cv->end; $s \|= 2 };
39
40	$cv->recv;
41
42	print $s == 3 ? "" : "not ", "ok 2 # $s\n";
43	}
44
45	# I/O read
46	{
47	my $cv = AE::cv;
48	my $wt = AE::timer 0.01, 0, $cv;
49	my $s = 0;
50
51	my $wa = AE::io $a, 0, sub { $cv->end; $s \|= 1 };
52	my $wb = AE::io $a, 0, sub { $cv->end; $s \|= 2 };
53
54	$cv->recv;
55
56	print $s == 0 ? "" : "not ", "ok 3 # $s\n";
57
58	syswrite $b, "x";
59
60	$cv = AE::cv;
61	$wt = AE::timer 1, 0, $cv;
62
63	$s = 0;
64	$cv->begin;
65	$cv->begin;
66	$cv->recv;
67
68	print $s == 3 ? "" : "not ", "ok 4 # $s\n";
69
70	sysread $a, my $dummy, 1;
71
72	$cv = AE::cv;
73	$wt = AE::timer 0.01, 0, $cv;
74
75	$s = 0;
76	$cv->recv;
77
78	print $s == 0 ? "" : "not ", "ok 5 # $s\n";
79	}
80
81	# signal
82	{
83	my $cv = AE::cv;
84	my $wt = AE::timer 0.01, 0, $cv;
85	my $s = 0;
86
87	$cv->begin; my $wa = AE::signal INT => sub { $cv->end; $s \|= 1 };
88	$cv->begin; my $wb = AE::signal INT => sub { $cv->end; $s \|= 2 };
89
90	$cv->recv;
91
92	print $s == 0 ? "" : "not ", "ok 6 # $s\n";
93
94	kill INT => $$;
95
96	$cv = AE::cv;
97	$wt = AE::timer 0.2, 0, $cv; # maybe OS X needs more time here? or maybe some buggy arm kernel?
98
99	$s = 0;
100	$cv->recv;
101
102	print $s == 3 ? "" : "not ", "ok 7 # $s\n";
103
104	$cv = AE::cv;
105	$wt = AE::timer 0.01, 0, $cv;
106
107	$s = 0;
108	$cv->recv;
109
110	print $s == 0 ? "" : "not ", "ok 8 # $s\n";
111	}
112
113	# child
114	{
115	my $cv = AE::cv;
116	my $wt = AE::timer 0.01, 0, $cv;
117	my $s = 0;
118
119	my $pid = fork;
120
121	unless ($pid) {
122	sleep 2;
123	exit 1;
124	}
125
126	my ($apid, $bpid, $astatus, $bstatus);
127
128	$cv->begin; my $wa = AE::child $pid, sub { ($apid, $astatus) = @_; $cv->end; $s \|= 1 };
129	$cv->begin; my $wb = AE::child $pid, sub { ($bpid, $bstatus) = @_; $cv->end; $s \|= 2 };
130
131	$cv->recv;
132
133	print $s == 0 ? "" : "not ", "ok 9 # $s\n";
134
135	kill 9, $pid;
136
137	$cv = AE::cv;
138	$wt = AE::timer 0.2, 0, $cv; # cygwin needs ages for this
139
140	$s = 0;
141	$cv->recv;
142
143	print $s == 3 ? "" : "not ", "ok 10 # $s\n";
144	print $apid == $pid && $bpid == $pid ? "" : "not ", "ok 11 # $apid == $bpid == $pid\n";
145	print $astatus == 9 && $bstatus == 9 ? "" : "not ", "ok 12 # $astatus == $bstatus == 9\n";
146
147	$cv = AE::cv;
148	$wt = AE::timer 0.01, 0, $cv;
149
150	$s = 0;
151	$cv->recv;
152
153	print $s == 0 ? "" : "not ", "ok 13 # $s\n";
154	}
155
156	# timers (don't laugh, some event loops are more broken...)
157	{
158	my $cv = AE::cv;
159	my $wt = AE::timer 1, 0, $cv;
160	my $s = 0;
161
162	$cv->begin; my $wa = AE::timer 0 , 0, sub { $cv->end; $s \|= 1 };
163	$cv->begin; my $wb = AE::timer 0 , 0, sub { $cv->end; $s \|= 2 };
164	$cv->begin; my $wc = AE::timer 0.01, 0, sub { $cv->end; $s \|= 4 };
165
166	$cv->recv;
167
168	print $s == 7 ? "" : "not ", "ok 14 # $s\n";
169	}
170
171	print "ok 15\n";
172
173	exit 0;
174