1 |
$|=1; |
2 |
BEGIN { |
3 |
print "1..7\n" |
4 |
} |
5 |
|
6 |
use AnyEvent; |
7 |
use AnyEvent::Impl::Perl; |
8 |
|
9 |
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 |
print "ok 1\n"; |
19 |
|
20 |
AnyEvent::detect; # force-load event model |
21 |
|
22 |
my $pid = fork; |
23 |
|
24 |
defined $pid or die "unable to fork"; |
25 |
|
26 |
# work around Tk bug until it has been fixed. |
27 |
#my $timer = AnyEvent->timer (after => 2, cb => sub { }); |
28 |
|
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 |
print $pid == $_[0] ? "" : "not ", "ok 3\ # $pid == $_[0]\n"; |
38 |
print 3 == ($_[1] >> 8) ? "" : "not ", "ok 4 # 3 == $_[1] >> 8 ($_[1])\n"; |
39 |
$cv->broadcast; |
40 |
}); |
41 |
|
42 |
$cv->wait; |
43 |
|
44 |
my $pid2 = fork || exit 7; |
45 |
|
46 |
my $cv2 = AnyEvent->condvar; |
47 |
|
48 |
my $w2 = AnyEvent->child (pid => 0, cb => sub { |
49 |
print $pid2 == $_[0] ? "" : "not ", "ok 5 # $pid2 == $_[0]\n"; |
50 |
print 7 == ($_[1] >> 8) ? "" : "not ", "ok 6 # 7 == $_[1] >> 8 ($_[1])\n"; |
51 |
$cv2->broadcast; |
52 |
}); |
53 |
|
54 |
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 |
$cv2->wait; |
62 |
|
63 |
print "ok 7\n"; |
64 |
|
65 |
|
66 |
|
67 |
|