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

$^W = 0; # 5.8.6 bugs

use AnyEvent;
use AnyEvent::Util;

         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::Tk;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Tk 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?

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