This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add watchdog() call to ext/IO/t/io_multihomed.t
[perl5.git] / ext / IO / t / io_multihomed.t
1 #!./perl
2
3 BEGIN {
4     unless(grep /blib/, @INC) {
5         chdir 't' if -d 't';
6         @INC = '../lib';
7     }
8
9     require($ENV{PERL_CORE} ? './test.pl' : './t/test.pl');
10
11     use Config;
12     my $can_fork = $Config{d_fork} ||
13                     (($^O eq 'MSWin32' || $^O eq 'NetWare') and
14                      $Config{useithreads} and 
15                      $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
16                     );
17     my $reason;
18     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bSocket\b/) {
19         $reason = 'Socket extension unavailable';
20     }
21     elsif ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
22         $reason = 'IO extension unavailable';
23     }
24     elsif (!$can_fork) {
25         $reason = 'no fork';
26     }
27     skip_all($reason) if $reason;
28 }
29
30 $| = 1;
31
32 print "1..8\n";
33 watchdog(15);
34
35 package Multi;
36 require IO::Socket::INET;
37 @ISA=qw(IO::Socket::INET);
38
39 use Socket qw(inet_aton inet_ntoa unpack_sockaddr_in);
40
41 sub _get_addr
42 {
43     my($sock,$addr_str, $multi) = @_;
44     #print "_get_addr($sock, $addr_str, $multi)\n";
45
46     print "not " unless $multi;
47     print "ok 2\n";
48
49     (
50      # private IP-addresses which I hope does not work anywhere :-)
51      inet_aton("10.250.230.10"),
52      inet_aton("10.250.230.12"),
53      inet_aton("127.0.0.1")        # loopback
54     )
55 }
56
57 sub connect
58 {
59     my $self = shift;
60     if (@_ == 1) {
61         my($port, $addr) = unpack_sockaddr_in($_[0]);
62         $addr = inet_ntoa($addr);
63         #print "connect($self, $port, $addr)\n";
64         if($addr eq "10.250.230.10") {
65             print "ok 3\n";
66             return 0;
67         }
68         if($addr eq "10.250.230.12") {
69             print "ok 4\n";
70             return 0;
71         }
72     }
73     $self->SUPER::connect(@_);
74 }
75
76
77
78 package main;
79
80 use IO::Socket;
81
82 $listen = IO::Socket::INET->new(Listen => 2,
83                                 Proto => 'tcp',
84                                 Timeout => 5,
85                                ) or die "$!";
86
87 print "ok 1\n";
88
89 $port = $listen->sockport;
90
91 if($pid = fork()) {
92
93     $sock = $listen->accept() or die "$!";
94     print "ok 5\n";
95
96     print $sock->getline();
97     print $sock "ok 7\n";
98
99     waitpid($pid,0);
100
101     $sock->close;
102
103     print "ok 8\n";
104
105 } elsif(defined $pid) {
106
107     $sock = Multi->new(PeerPort => $port,
108                        Proto => 'tcp',
109                        PeerAddr => 'localhost',
110                        MultiHomed => 1,
111                        Timeout => 1,
112                       ) or die "$!";
113
114     print $sock "ok 6\n";
115     sleep(1); # race condition
116     print $sock->getline();
117
118     $sock->close;
119
120     exit;
121 } else {
122     die;
123 }