ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/t/09_multi.t
Revision: 1.9
Committed: Sat Oct 1 22:48:36 2011 UTC (13 years, 2 months ago) by root
Content type: application/x-troff
Branch: MAIN
CVS Tags: rel-7_0, rel-6_1, rel-6_14, rel-6_11, rel-6_12, rel-6_13, rel-7_04, rel-7_05, rel-7_07, rel-7_01, rel-7_02, rel-7_03, 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.8: +1 -1 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.3 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.6 $^W = 0; # 5.8.6 bugs
18    
19 root 1.1 use AnyEvent;
20     use AnyEvent::Util;
21     BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} }
22    
23 root 1.4 $| = 1; print "1..15\n";
24 root 1.1
25     print "ok 1\n";
26    
27 root 1.8 $AnyEvent::MAX_SIGNAL_LATENCY = 0.05;
28    
29 root 1.1 my ($a, $b) = AnyEvent::Util::portable_socketpair;
30    
31     # I/O write
32     {
33     my $cv = AE::cv;
34 root 1.4 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.5 my $wt = AE::timer 0.01, 0, $cv;
49 root 1.1 my $s = 0;
50    
51 root 1.2 my $wa = AE::io $a, 0, sub { $cv->end; $s |= 1 };
52     my $wb = AE::io $a, 0, sub { $cv->end; $s |= 2 };
53 root 1.1
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.4 $wt = AE::timer 1, 0, $cv;
62 root 1.1
63     $s = 0;
64 root 1.2 $cv->begin;
65     $cv->begin;
66 root 1.1 $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.5 $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.5 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.9 $wt = AE::timer 0.2, 0, $cv; # maybe OS X needs more time here? or maybe some buggy arm kernel?
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.5 $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     # child
114     {
115     my $cv = AE::cv;
116 root 1.5 my $wt = AE::timer 0.01, 0, $cv;
117 root 1.1 my $s = 0;
118    
119     my $pid = fork;
120    
121     unless ($pid) {
122     sleep 2;
123     exit 1;
124     }
125    
126     my ($apid, $bpid, $astatus, $bstatus);
127    
128     $cv->begin; my $wa = AE::child $pid, sub { ($apid, $astatus) = @_; $cv->end; $s |= 1 };
129     $cv->begin; my $wb = AE::child $pid, sub { ($bpid, $bstatus) = @_; $cv->end; $s |= 2 };
130    
131     $cv->recv;
132    
133     print $s == 0 ? "" : "not ", "ok 9 # $s\n";
134    
135     kill 9, $pid;
136    
137     $cv = AE::cv;
138 root 1.6 $wt = AE::timer 0.2, 0, $cv; # cygwin needs ages for this
139 root 1.1
140     $s = 0;
141     $cv->recv;
142    
143     print $s == 3 ? "" : "not ", "ok 10 # $s\n";
144     print $apid == $pid && $bpid == $pid ? "" : "not ", "ok 11 # $apid == $bpid == $pid\n";
145     print $astatus == 9 && $bstatus == 9 ? "" : "not ", "ok 12 # $astatus == $bstatus == 9\n";
146    
147     $cv = AE::cv;
148 root 1.5 $wt = AE::timer 0.01, 0, $cv;
149 root 1.1
150     $s = 0;
151     $cv->recv;
152    
153     print $s == 0 ? "" : "not ", "ok 13 # $s\n";
154     }
155    
156 root 1.4 # timers (don't laugh, some event loops are more broken...)
157     {
158     my $cv = AE::cv;
159     my $wt = AE::timer 1, 0, $cv;
160     my $s = 0;
161    
162     $cv->begin; my $wa = AE::timer 0 , 0, sub { $cv->end; $s |= 1 };
163     $cv->begin; my $wb = AE::timer 0 , 0, sub { $cv->end; $s |= 2 };
164     $cv->begin; my $wc = AE::timer 0.01, 0, sub { $cv->end; $s |= 4 };
165    
166     $cv->recv;
167    
168     print $s == 7 ? "" : "not ", "ok 14 # $s\n";
169     }
170    
171     print "ok 15\n";
172 root 1.1
173     exit 0;
174