AnyEvent/t/70_uv_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::UV;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::UV 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.1
Committed:	Fri Aug 29 06:24:13 2014 UTC (9 years, 9 months ago) by root
Content type:	application/x-troff
Branch:	MAIN
CVS Tags:	rel-7_16, rel-7_15, rel-7_14, rel-7_13, rel-7_12, rel-7_11, rel-7_08, rel-7_09, HEAD
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.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
22			BEGIN { $^W = 0 }
23			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::UV;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::UV not loadable\n}), exit 0) }
25
26
27
28			$\| = 1; print "1..15\n";
29
30			print "ok 1\n";
31
32			$AnyEvent::MAX_SIGNAL_LATENCY = 0.05;
33
34			my ($a, $b) = AnyEvent::Util::portable_socketpair;
35
36			# I/O write
37			{
38			my $cv = AE::cv;
39			my $wt = AE::timer 1, 0, $cv;
40			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			my $wt = AE::timer 0.01, 0, $cv;
54			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			$wt = AE::timer 1, 0, $cv;
67
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			$wt = AE::timer 0.01, 0, $cv;
79
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			my $wt = AE::timer 0.01, 0, $cv;
90			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			$wt = AE::timer 0.2, 0, $cv; # maybe OS X needs more time here? or maybe some buggy arm kernel?
103
104			$s = 0;
105			$cv->recv;
106
107			print $s == 3 ? "" : "not ", "ok 7 # $s\n";
108
109			$cv = AE::cv;
110			$wt = AE::timer 0.01, 0, $cv;
111
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			my $wt = AE::timer 0.01, 0, $cv;
122			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			$wt = AE::timer 0.2, 0, $cv; # cygwin needs ages for this
144
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			$wt = AE::timer 0.01, 0, $cv;
154
155			$s = 0;
156			$cv->recv;
157
158			print $s == 0 ? "" : "not ", "ok 13 # $s\n";
159			}
160
161			# 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
178			exit 0;
179