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