AnyEvent/t/67_tk_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 { eval q{use AnyEvent::Impl::Tk;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Tk not loadable
}), exit 0) } 

$| = 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.1, 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.1, 0, $cv;

   $s = 0;
   $cv->recv;

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

# signal
{
   my $cv = AE::cv;
   my $wt = AE::timer 0.1, 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.1, 0, $cv;

   $s = 0;
   $cv->recv;

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

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