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