Move IO from ext/ to dist/
[perl.git] / dist / IO / t / io_udp.t
1 #!./perl
2
3 BEGIN {
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
21 sub 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
42 plan(7);
43 watchdog(15);
44
45 use Socket;
46 use 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)";
51 ok(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)";
56 ok(1);
57
58 $udpa->send('BORK', 0, $udpb->sockname);
59
60 ok(compare_addr($udpa->peername,$udpb->sockname, 'peername', 'sockname'));
61
62 my $where = $udpb->recv($buf="", 4);
63 is($buf, 'BORK');
64
65 my @xtra = ();
66
67 if (! 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);
73 is($buf, 'FOObar');
74
75 ok(! $udpa->connected);
76
77 exit(0);
78
79 # EOF