AnyEvent/t/69_ev_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 { $^W = 0 }
         BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) }
         BEGIN { eval q{use AnyEvent::Impl::EV;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::EV not loadable\n}), exit 0) }
         
      

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