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