ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/t/61_fltk_09_multi.t
Revision: 1.5
Committed: Sat Oct 1 22:39:29 2011 UTC (13 years, 2 months ago) by root
Content type: application/x-troff
Branch: MAIN
CVS Tags: rel-6_1, rel-6_14, rel-6_11, rel-6_12, rel-6_13
Changes since 1.4: +3 -3 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 root 1.5 $AnyEvent::MAX_SIGNAL_LATENCY = 0.05;
32    
33 root 1.1 my ($a, $b) = AnyEvent::Util::portable_socketpair;
34    
35     # I/O write
36     {
37     my $cv = AE::cv;
38     my $wt = AE::timer 1, 0, $cv;
39     my $s = 0;
40    
41     $cv->begin; my $wa = AE::io $a, 1, sub { $cv->end; $s |= 1 };
42     $cv->begin; my $wb = AE::io $a, 1, sub { $cv->end; $s |= 2 };
43    
44     $cv->recv;
45    
46     print $s == 3 ? "" : "not ", "ok 2 # $s\n";
47     }
48    
49     # I/O read
50     {
51     my $cv = AE::cv;
52     my $wt = AE::timer 0.01, 0, $cv;
53     my $s = 0;
54    
55     my $wa = AE::io $a, 0, sub { $cv->end; $s |= 1 };
56     my $wb = AE::io $a, 0, sub { $cv->end; $s |= 2 };
57    
58     $cv->recv;
59    
60     print $s == 0 ? "" : "not ", "ok 3 # $s\n";
61    
62     syswrite $b, "x";
63    
64     $cv = AE::cv;
65     $wt = AE::timer 1, 0, $cv;
66    
67     $s = 0;
68     $cv->begin;
69     $cv->begin;
70     $cv->recv;
71    
72     print $s == 3 ? "" : "not ", "ok 4 # $s\n";
73    
74     sysread $a, my $dummy, 1;
75    
76     $cv = AE::cv;
77     $wt = AE::timer 0.01, 0, $cv;
78    
79     $s = 0;
80     $cv->recv;
81    
82     print $s == 0 ? "" : "not ", "ok 5 # $s\n";
83     }
84    
85     # signal
86     {
87     my $cv = AE::cv;
88     my $wt = AE::timer 0.01, 0, $cv;
89     my $s = 0;
90    
91     $cv->begin; my $wa = AE::signal INT => sub { $cv->end; $s |= 1 };
92     $cv->begin; my $wb = AE::signal INT => sub { $cv->end; $s |= 2 };
93    
94     $cv->recv;
95    
96     print $s == 0 ? "" : "not ", "ok 6 # $s\n";
97    
98     kill INT => $$;
99    
100     $cv = AE::cv;
101 root 1.5 $wt = AE::timer 0.2, 0, $cv; # maybe OS X needs more time here?
102 root 1.1
103     $s = 0;
104     $cv->recv;
105    
106     print $s == 3 ? "" : "not ", "ok 7 # $s\n";
107    
108     $cv = AE::cv;
109     $wt = AE::timer 0.01, 0, $cv;
110    
111     $s = 0;
112     $cv->recv;
113    
114     print $s == 0 ? "" : "not ", "ok 8 # $s\n";
115     }
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