AnyEvent/t/61_fltk_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::FLTK2;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::FLTK2 not loadable\n}), 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.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.01, 0, $cv;

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

$AnyEvent::MAX_SIGNAL_LATENCY = 0.2;

# 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.01, 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.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.2
Committed:	Fri Aug 26 03:34:00 2011 UTC (14 years, 5 months ago) by root
Content type:	application/x-troff
Branch:	MAIN
CVS Tags:	rel-6_01
Changes since 1.1:	+2 -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 { $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::FLTK2;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::FLTK2 not loadable\n}), exit 0) }
24
25
26
27	$\| = 1; print "1..15\n";
28
29	print "ok 1\n";
30
31	my ($a, $b) = AnyEvent::Util::portable_socketpair;
32
33	# I/O write
34	{
35	my $cv = AE::cv;
36	my $wt = AE::timer 1, 0, $cv;
37	my $s = 0;
38
39	$cv->begin; my $wa = AE::io $a, 1, sub { $cv->end; $s \|= 1 };
40	$cv->begin; my $wb = AE::io $a, 1, sub { $cv->end; $s \|= 2 };
41
42	$cv->recv;
43
44	print $s == 3 ? "" : "not ", "ok 2 # $s\n";
45	}
46
47	# I/O read
48	{
49	my $cv = AE::cv;
50	my $wt = AE::timer 0.01, 0, $cv;
51	my $s = 0;
52
53	my $wa = AE::io $a, 0, sub { $cv->end; $s \|= 1 };
54	my $wb = AE::io $a, 0, sub { $cv->end; $s \|= 2 };
55
56	$cv->recv;
57
58	print $s == 0 ? "" : "not ", "ok 3 # $s\n";
59
60	syswrite $b, "x";
61
62	$cv = AE::cv;
63	$wt = AE::timer 1, 0, $cv;
64
65	$s = 0;
66	$cv->begin;
67	$cv->begin;
68	$cv->recv;
69
70	print $s == 3 ? "" : "not ", "ok 4 # $s\n";
71
72	sysread $a, my $dummy, 1;
73
74	$cv = AE::cv;
75	$wt = AE::timer 0.01, 0, $cv;
76
77	$s = 0;
78	$cv->recv;
79
80	print $s == 0 ? "" : "not ", "ok 5 # $s\n";
81	}
82
83	# signal
84	{
85	my $cv = AE::cv;
86	my $wt = AE::timer 0.01, 0, $cv;
87	my $s = 0;
88
89	$cv->begin; my $wa = AE::signal INT => sub { $cv->end; $s \|= 1 };
90	$cv->begin; my $wb = AE::signal INT => sub { $cv->end; $s \|= 2 };
91
92	$cv->recv;
93
94	print $s == 0 ? "" : "not ", "ok 6 # $s\n";
95
96	kill INT => $$;
97
98	$cv = AE::cv;
99	$wt = AE::timer 0.01, 0, $cv;
100
101	$s = 0;
102	$cv->recv;
103
104	print $s == 3 ? "" : "not ", "ok 7 # $s\n";
105
106	$cv = AE::cv;
107	$wt = AE::timer 0.01, 0, $cv;
108
109	$s = 0;
110	$cv->recv;
111
112	print $s == 0 ? "" : "not ", "ok 8 # $s\n";
113	}
114
115	$AnyEvent::MAX_SIGNAL_LATENCY = 0.2;
116
117	# child
118	{
119	my $cv = AE::cv;
120	my $wt = AE::timer 0.01, 0, $cv;
121	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	$wt = AE::timer 0.01, 0, $cv;
143
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	$wt = AE::timer 0.01, 0, $cv;
153
154	$s = 0;
155	$cv->recv;
156
157	print $s == 0 ? "" : "not ", "ok 13 # $s\n";
158	}
159
160	# 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
177	exit 0;
178