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