1#!./perl 2 3BEGIN { 4 require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl'); 5 6 use Config; 7 my $reason; 8 if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bSocket\b/) { 9 $reason = 'Socket was not built'; 10 } 11 elsif ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) { 12 $reason = 'IO was not built'; 13 } 14 elsif ($^O eq 'apollo') { 15 $reason = "unknown *FIXME*"; 16 } 17 undef $reason if $^O eq 'VMS' and $Config{d_socket}; 18 skip_all($reason) if $reason; 19} 20 21sub compare_addr { 22 no utf8; 23 my $a = shift; 24 my $b = shift; 25 if (length($a) != length $b) { 26 my $min = (length($a) < length $b) ? length($a) : length $b; 27 if ($min and substr($a, 0, $min) eq substr($b, 0, $min)) { 28 printf "# Apparently: %d bytes junk at the end of %s\n# %s\n", 29 abs(length($a) - length ($b)), 30 $_[length($a) < length ($b) ? 1 : 0], 31 "consider decreasing bufsize of recfrom."; 32 substr($a, $min) = ""; 33 substr($b, $min) = ""; 34 } 35 return 0; 36 } 37 my @a = unpack_sockaddr_in($a); 38 my @b = unpack_sockaddr_in($b); 39 "$a[0]$a[1]" eq "$b[0]$b[1]"; 40} 41 42plan(7); 43watchdog(15); 44 45use Socket; 46use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY); 47 48$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost') 49 || IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1') 50 or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)"; 51ok(1); 52 53$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost') 54 || IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1') 55 or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)"; 56ok(1); 57 58$udpa->send('BORK', 0, $udpb->sockname); 59 60ok(compare_addr($udpa->peername,$udpb->sockname, 'peername', 'sockname')); 61 62my $where = $udpb->recv($buf="", 4); 63is($buf, 'BORK'); 64 65my @xtra = (); 66 67if (! ok(compare_addr($where,$udpa->sockname, 'recv name', 'sockname'))) { 68 @xtra = (0, $udpa->sockname); 69} 70 71$udpb->send('FOObar', @xtra); 72$udpa->recv($buf="", 6); 73is($buf, 'FOObar'); 74 75ok(! $udpa->connected); 76 77exit(0); 78 79# EOF 80