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