ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/t/67_tk_03_child.t
(Generate patch)

Comparing AnyEvent/t/67_tk_03_child.t (file contents):
Revision 1.1 by root, Thu Oct 2 08:43:58 2008 UTC vs.
Revision 1.11 by root, Fri Aug 12 18:41:29 2011 UTC

1$|=1; 1use POSIX ();
2
3no warnings;
2 4
3BEGIN { 5BEGIN {
4 # check for broken perls 6 # check for broken perls
5 if ($^O =~ /mswin32/i) { 7 if ($^O =~ /mswin32/i) {
6 my $ok; 8 my $ok;
7 local $SIG{CHLD} = sub { $ok = 1 }; 9 local $SIG{CHLD} = sub { $ok = 1 };
8 kill 'CHLD', 0; 10 kill 'CHLD', 0;
9 11
10 unless ($ok) { 12 unless ($ok) {
11 print <<EOF; 13 print <<EOF;
121..0 # 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. 141..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.
13EOF 15EOF
14 exit 0; 16 exit 0;
15 } 17 }
16 } 18 }
17} 19}
18 20
19BEGIN { 21use AnyEvent;
20 print "1..7\n"
21}
22 22
23use AnyEvent; 23 BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) }
24use AnyEvent::Impl::Tk; 24 BEGIN { eval q{use AnyEvent::Impl::Tk;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Tk not loadable\n}), exit 0) }
25
26
25 27
26print "ok 1\n"; 28$| = 1; print "1..50\n";
27 29
28AnyEvent::detect; # force-load event model 30$AnyEvent::MAX_SIGNAL_LATENCY = 0.2;
29 31
30my $pid = fork; 32for my $it ("", 1, 2, 3, 4) {
33 print "ok ${it}1\n";
31 34
32defined $pid or die "unable to fork"; 35 AnyEvent::detect; # force-load event model
33 36
34# work around Tk bug until it has been fixed. 37 my $pid = fork;
35#my $timer = AnyEvent->timer (after => 2, cb => sub { });
36 38
37my $cv = AnyEvent->condvar; 39 defined $pid or die "unable to fork";
38 40
39unless ($pid) { 41 # work around Tk bug until it has been fixed.
40 print "ok 2\n"; 42 #my $timer = AnyEvent->timer (after => 2, cb => sub { });
41 exit 3;
42}
43 43
44my $w = AnyEvent->child (pid => $pid, cb => sub { 44 my $cv = AnyEvent->condvar;
45 print $pid == $_[0] ? "" : "not ", "ok 3\ # $pid == $_[0]\n";
46 print 3 == ($_[1] >> 8) ? "" : "not ", "ok 4 # 3 == $_[1] >> 8 ($_[1])\n";
47 $cv->broadcast;
48});
49 45
50$cv->wait; 46 unless ($pid) {
47 print "ok ${it}2\n";
48 POSIX::_exit 3;
49 }
51 50
52my $pid2 = fork || exit 7; 51 my $w = AnyEvent->child (pid => $pid, cb => sub {
52 print $pid == $_[0] ? "" : "not ", "ok ${it}3\ # $pid == $_[0]\n";
53 print 3 == ($_[1] >> 8) ? "" : "not ", "ok ${it}4 # 3 == $_[1] >> 8 ($_[1])\n";
54 $cv->broadcast;
55 });
53 56
54my $cv2 = AnyEvent->condvar; 57 $cv->recv;
55 58
56my $w2 = AnyEvent->child (pid => 0, cb => sub { 59 my $pid2 = fork || POSIX::_exit 7;
57 print $pid2 == $_[0] ? "" : "not ", "ok 5 # $pid2 == $_[0]\n";
58 print 7 == ($_[1] >> 8) ? "" : "not ", "ok 6 # 7 == $_[1] >> 8 ($_[1])\n";
59 $cv2->broadcast;
60});
61 60
61 my $cv2 = AnyEvent->condvar;
62
63 # Glib is the only model that doesn't support pid == 0
64 my $pid0 = $AnyEvent::MODEL eq "AnyEvent::Impl::Glib" ? $pid2 : 0;
65
66 my $w2 = AnyEvent->child (pid => $pid0, cb => sub {
67 print $pid2 == $_[0] ? "" : "not ", "ok ${it}5 # $pid2 == $_[0]\n";
68 print 7 == ($_[1] >> 8) ? "" : "not ", "ok ${it}6 # 7 == $_[1] >> 8 ($_[1])\n";
69 $cv2->broadcast;
70 });
71
62my $error = AnyEvent->timer (after => 5, cb => sub { 72 my $error = AnyEvent->timer (after => 5, cb => sub {
63 print <<EOF; 73 print <<EOF;
64Bail 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"; 74Bail 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";
65EOF 75EOF
66 exit 0; 76 exit 0;
67}); 77 });
68 78
69$cv2->wait; 79 $cv2->recv;
70 80
71print "ok 7\n"; 81 print "ok ${it}7\n";
82 print "ok ${it}8\n";
83 print "ok ${it}9\n";
84 print "ok ", $it*10+10, "\n";
85}
72 86
73 87
74 88
75 89

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines