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?

   $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.8
Committed:	Sat Aug 27 16:01:49 2011 UTC (12 years, 9 months ago) by root
Content type:	application/x-troff
Branch:	MAIN
Changes since 1.7:	+2 -2 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.6	$^W = 0; # 5.8.6 bugs
18
19	root	1.1	use AnyEvent;
20			use AnyEvent::Util;
21			BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} }
22
23	root	1.4	$\| = 1; print "1..15\n";
24	root	1.1
25			print "ok 1\n";
26
27	root	1.8	$AnyEvent::MAX_SIGNAL_LATENCY = 0.05;
28
29	root	1.1	my ($a, $b) = AnyEvent::Util::portable_socketpair;
30
31			# I/O write
32			{
33			my $cv = AE::cv;
34	root	1.4	my $wt = AE::timer 1, 0, $cv;
35	root	1.1	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	root	1.5	my $wt = AE::timer 0.01, 0, $cv;
49	root	1.1	my $s = 0;
50
51	root	1.2	my $wa = AE::io $a, 0, sub { $cv->end; $s \|= 1 };
52			my $wb = AE::io $a, 0, sub { $cv->end; $s \|= 2 };
53	root	1.1
54			$cv->recv;
55
56			print $s == 0 ? "" : "not ", "ok 3 # $s\n";
57
58			syswrite $b, "x";
59
60			$cv = AE::cv;
61	root	1.4	$wt = AE::timer 1, 0, $cv;
62	root	1.1
63			$s = 0;
64	root	1.2	$cv->begin;
65			$cv->begin;
66	root	1.1	$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	root	1.5	$wt = AE::timer 0.01, 0, $cv;
74	root	1.1
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	root	1.5	my $wt = AE::timer 0.01, 0, $cv;
85	root	1.1	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	root	1.7	$wt = AE::timer 0.2, 0, $cv; # maybe OS X needs more time here?
98	root	1.1
99			$s = 0;
100			$cv->recv;
101
102			print $s == 3 ? "" : "not ", "ok 7 # $s\n";
103
104			$cv = AE::cv;
105	root	1.5	$wt = AE::timer 0.01, 0, $cv;
106	root	1.1
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	root	1.5	my $wt = AE::timer 0.01, 0, $cv;
117	root	1.1	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	root	1.6	$wt = AE::timer 0.2, 0, $cv; # cygwin needs ages for this
139	root	1.1
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	root	1.5	$wt = AE::timer 0.01, 0, $cv;
149	root	1.1
150			$s = 0;
151			$cv->recv;
152
153			print $s == 0 ? "" : "not ", "ok 13 # $s\n";
154			}
155
156	root	1.4	# 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	root	1.1
173			exit 0;
174