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
CommitLineData
cf7fe8a2
GS
1#!./perl
2
3BEGIN {
4 unless(grep /blib/, @INC) {
5 chdir 't' if -d 't';
20822f61 6 @INC = '../lib';
cf7fe8a2 7 }
cf7fe8a2 8
ed272d6f 9 require($ENV{PERL_CORE} ? './test.pl' : './t/test.pl');
cf7fe8a2 10
ed272d6f 11 use Config;
ec64f737
SH
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 );
90b9a713
GB
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 }
ec64f737
SH
24 elsif (!$can_fork) {
25 $reason = 'no fork';
90b9a713 26 }
ed272d6f 27 skip_all($reason) if $reason;
cf7fe8a2
GS
28}
29
30$| = 1;
31
32print "1..8\n";
ed272d6f 33watchdog(15);
cf7fe8a2
GS
34
35package Multi;
36require IO::Socket::INET;
37@ISA=qw(IO::Socket::INET);
38
39use Socket qw(inet_aton inet_ntoa unpack_sockaddr_in);
40
41sub _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
57sub 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";
362d283a
GB
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 }
cf7fe8a2
GS
72 }
73 $self->SUPER::connect(@_);
74}
75
76
77
78package main;
79
80use IO::Socket;
81
82$listen = IO::Socket::INET->new(Listen => 2,
83 Proto => 'tcp',
84 Timeout => 5,
85 ) or die "$!";
86
87print "ok 1\n";
88
89$port = $listen->sockport;
90
91if($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}