ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/t/61_fltk_09_multi.t
Revision: 1.4
Committed: Sat Aug 27 15:59:12 2011 UTC (13 years, 3 months ago) by root
Content type: application/x-troff
Branch: MAIN
Changes since 1.3: +1 -1 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.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 root 1.2 $^W = 0; # 5.8.6 bugs
18    
19 root 1.1 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 root 1.3 BEGIN { eval q{use AnyEvent::Impl::FLTK;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::FLTK not loadable\n}), exit 0) }
24 root 1.1
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 root 1.4 $wt = AE::timer 0.1, 0, $cv; # maybe OS X needs more time here?
100 root 1.1
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 root 1.3 $wt = AE::timer 0.2, 0, $cv; # cygwin needs ages for this
143 root 1.1
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