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