1 |
root |
1.1 |
$|=1; |
2 |
root |
1.8 |
BEGIN { |
3 |
|
|
print "1..7\n" |
4 |
|
|
} |
5 |
root |
1.1 |
|
6 |
|
|
use AnyEvent; |
7 |
root |
1.5 |
use AnyEvent::Impl::Perl; |
8 |
root |
1.1 |
|
9 |
root |
1.8 |
print STDERR <<EOF; |
10 |
|
|
|
11 |
|
|
If the following test hangs for a long time you either found a bug in |
12 |
|
|
AnyEvent or, more likely, you have a defective perl (most windows perl |
13 |
|
|
distros are broken, cygwin perl works). If you do not rely on child |
14 |
|
|
handlers you can force the installation of this module and the rest will |
15 |
|
|
likely work. Otherwise upgrading to a working perl is recommended. |
16 |
|
|
EOF |
17 |
|
|
|
18 |
root |
1.1 |
print "ok 1\n"; |
19 |
|
|
|
20 |
|
|
my $pid = fork; |
21 |
|
|
|
22 |
|
|
defined $pid or die "unable to fork"; |
23 |
|
|
|
24 |
|
|
# work around Tk bug until it has been fixed. |
25 |
root |
1.6 |
#my $timer = AnyEvent->timer (after => 2, cb => sub { }); |
26 |
root |
1.1 |
|
27 |
|
|
my $cv = AnyEvent->condvar; |
28 |
|
|
|
29 |
|
|
unless ($pid) { |
30 |
|
|
print "ok 2\n"; |
31 |
|
|
exit 3; |
32 |
|
|
} |
33 |
|
|
|
34 |
|
|
my $w = AnyEvent->child (pid => $pid, cb => sub { |
35 |
root |
1.7 |
print $pid == $_[0] ? "" : "not ", "ok 3\ # $pid == $_[0]\n"; |
36 |
|
|
print 3 == ($_[1] >> 8) ? "" : "not ", "ok 4 # 3 == $_[1] >> 8 ($_[1])\n"; |
37 |
root |
1.1 |
$cv->broadcast; |
38 |
|
|
}); |
39 |
|
|
|
40 |
|
|
$cv->wait; |
41 |
|
|
|
42 |
root |
1.3 |
my $pid2 = fork || exit 7; |
43 |
root |
1.2 |
|
44 |
|
|
my $cv2 = AnyEvent->condvar; |
45 |
|
|
|
46 |
|
|
my $w2 = AnyEvent->child (pid => 0, cb => sub { |
47 |
root |
1.7 |
print $pid2 == $_[0] ? "" : "not ", "ok 5 # $pid2 == $_[0]\n"; |
48 |
|
|
print 7 == ($_[1] >> 8) ? "" : "not ", "ok 6 # 7 == $_[1] >> 8 ($_[1])\n"; |
49 |
root |
1.2 |
$cv2->broadcast; |
50 |
|
|
}); |
51 |
|
|
|
52 |
root |
1.8 |
my $error = AnyEvent->timer (after => 5, cb => sub { |
53 |
|
|
print <<EOF; |
54 |
|
|
Bail out! No child exit detected. This is either a bug in AnyEvent or a bug in your Perl (mostly some windows distributions suffer from that): child watchers might not work properly on this platform. You can force installation of this module if you do not rely on child watchers, or you could upgrade to a working version of Perl for your platform.\n"; |
55 |
|
|
EOF |
56 |
|
|
exit 0; |
57 |
|
|
}); |
58 |
|
|
|
59 |
root |
1.2 |
$cv2->wait; |
60 |
|
|
|
61 |
root |
1.3 |
print "ok 7\n"; |
62 |
root |
1.1 |
|
63 |
|
|
|
64 |
|
|
|
65 |
|
|
|