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 |
root |
1.9 |
AnyEvent::detect; # force-load event model |
21 |
|
|
|
22 |
root |
1.1 |
my $pid = fork; |
23 |
|
|
|
24 |
|
|
defined $pid or die "unable to fork"; |
25 |
|
|
|
26 |
|
|
# work around Tk bug until it has been fixed. |
27 |
root |
1.6 |
#my $timer = AnyEvent->timer (after => 2, cb => sub { }); |
28 |
root |
1.1 |
|
29 |
|
|
my $cv = AnyEvent->condvar; |
30 |
|
|
|
31 |
|
|
unless ($pid) { |
32 |
|
|
print "ok 2\n"; |
33 |
|
|
exit 3; |
34 |
|
|
} |
35 |
|
|
|
36 |
|
|
my $w = AnyEvent->child (pid => $pid, cb => sub { |
37 |
root |
1.7 |
print $pid == $_[0] ? "" : "not ", "ok 3\ # $pid == $_[0]\n"; |
38 |
|
|
print 3 == ($_[1] >> 8) ? "" : "not ", "ok 4 # 3 == $_[1] >> 8 ($_[1])\n"; |
39 |
root |
1.1 |
$cv->broadcast; |
40 |
|
|
}); |
41 |
|
|
|
42 |
|
|
$cv->wait; |
43 |
|
|
|
44 |
root |
1.3 |
my $pid2 = fork || exit 7; |
45 |
root |
1.2 |
|
46 |
|
|
my $cv2 = AnyEvent->condvar; |
47 |
|
|
|
48 |
|
|
my $w2 = AnyEvent->child (pid => 0, cb => sub { |
49 |
root |
1.7 |
print $pid2 == $_[0] ? "" : "not ", "ok 5 # $pid2 == $_[0]\n"; |
50 |
|
|
print 7 == ($_[1] >> 8) ? "" : "not ", "ok 6 # 7 == $_[1] >> 8 ($_[1])\n"; |
51 |
root |
1.2 |
$cv2->broadcast; |
52 |
|
|
}); |
53 |
|
|
|
54 |
root |
1.8 |
my $error = AnyEvent->timer (after => 5, cb => sub { |
55 |
|
|
print <<EOF; |
56 |
|
|
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"; |
57 |
|
|
EOF |
58 |
|
|
exit 0; |
59 |
|
|
}); |
60 |
|
|
|
61 |
root |
1.2 |
$cv2->wait; |
62 |
|
|
|
63 |
root |
1.3 |
print "ok 7\n"; |
64 |
root |
1.1 |
|
65 |
|
|
|
66 |
|
|
|
67 |
|
|
|