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

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