AnyEvent/t/62_cocoa_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::Cocoa;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Cocoa 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.4
Committed:	Fri Aug 12 18:41:27 2011 UTC (13 years, 4 months ago) by root
Content type:	application/x-troff
Branch:	MAIN
CVS Tags:	rel-6_0
Changes since 1.3:	+13 -10 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	root	1.4
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::Cocoa;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Cocoa not loadable\n}), exit 0) }
22
23
24	root	1.1
25	root	1.3	$\| = 1; print "1..15\n";
26	root	1.1
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	root	1.3	my $wt = AE::timer 1, 0, $cv;
35	root	1.1	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	root	1.4	my $wt = AE::timer 0.01, 0, $cv;
49	root	1.1	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	root	1.3	$wt = AE::timer 1, 0, $cv;
62	root	1.1
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	root	1.4	$wt = AE::timer 0.01, 0, $cv;
74	root	1.1
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	root	1.4	my $wt = AE::timer 0.01, 0, $cv;
85	root	1.1	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	root	1.4	$wt = AE::timer 0.01, 0, $cv;
98	root	1.1
99			$s = 0;
100			$cv->recv;
101
102			print $s == 3 ? "" : "not ", "ok 7 # $s\n";
103
104			$cv = AE::cv;
105	root	1.4	$wt = AE::timer 0.01, 0, $cv;
106	root	1.1
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	root	1.4	my $wt = AE::timer 0.01, 0, $cv;
119	root	1.1	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	root	1.4	$wt = AE::timer 0.01, 0, $cv;
141	root	1.1
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	root	1.4	$wt = AE::timer 0.01, 0, $cv;
151	root	1.1
152			$s = 0;
153			$cv->recv;
154
155			print $s == 0 ? "" : "not ", "ok 13 # $s\n";
156			}
157
158	root	1.3	# 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	root	1.1
175			exit 0;
176