1ae24a0bbac8b71009ffddcad839d86826b2fc0d
[perl.git] / cpan / Socket / t / sockaddr.t
1 #!./perl
2
3 use strict;
4 use warnings;
5
6 use Socket qw(
7     AF_INET
8     inet_ntoa inet_aton inet_ntop inet_pton
9     pack_sockaddr_in unpack_sockaddr_in sockaddr_in
10     sockaddr_family
11     sockaddr_un
12 );
13 use Test::More tests => 33;
14
15 # inet_aton, inet_ntoa
16 {
17     is(join(".", unpack("C*",inet_aton("10.20.30.40"))), "10.20.30.40", 'inet_aton returns packed bytes');
18
19     is(inet_ntoa(v10.20.30.40), "10.20.30.40", 'inet_ntoa from v-string');
20
21     is(inet_ntoa(inet_aton("10.20.30.40")), "10.20.30.40", 'inet_aton->inet_ntoa roundtrip');
22
23     local $@;
24     eval { inet_ntoa(v10.20.30.400) };
25     like($@, qr/^Wide character in Socket::inet_ntoa at/, 'inet_ntoa warns about wide characters');
26 }
27
28 # inet_ntop, inet_pton
29 SKIP: {
30     skip "No inet_ntop", 5 unless defined eval { inet_pton(AF_INET, "10.20.30.40") };
31
32     is(join(".", unpack("C*",inet_pton(AF_INET, "10.20.30.40"))), "10.20.30.40", 'inet_pton AF_INET returns packed bytes');
33
34     is(inet_ntop(AF_INET, v10.20.30.40), "10.20.30.40", 'inet_ntop AF_INET from v-string');
35
36     is(inet_ntop(AF_INET, inet_pton(AF_INET, "10.20.30.40")), "10.20.30.40", 'inet_pton->inet_ntop AF_INET roundtrip');
37     is(inet_ntop(AF_INET, inet_aton("10.20.30.40")), "10.20.30.40", 'inet_aton->inet_ntop AF_INET roundtrip');
38
39     local $@;
40     eval { inet_ntop(AF_INET, v10.20.30.400) };
41     like($@, qr/^Wide character in Socket::inet_ntop at/, 'inet_ntop warns about wide characters');
42 }
43
44 SKIP: {
45     skip "No AF_INET6", 3 unless my $AF_INET6 = eval { Socket::AF_INET6() };
46     skip "No inet_ntop", 3 unless defined eval { inet_pton($AF_INET6, "2460::1") };
47
48     is(uc unpack("H*",inet_pton($AF_INET6, "2001:503:BA3E::2:30")), "20010503BA3E00000000000000020030",
49         'inet_pton AF_INET6 returns packed bytes');
50
51     is(uc inet_ntop($AF_INET6, "\x20\x01\x05\x03\xBA\x3E\x00\x00\x00\x00\x00\x00\x00\x02\x00\x30"), "2001:503:BA3E::2:30",
52         'inet_ntop AF_INET6 from octet string');
53
54     is(lc inet_ntop($AF_INET6, inet_pton($AF_INET6, "2001:503:BA3E::2:30")), "2001:503:ba3e::2:30",
55         'inet_pton->inet_ntop AF_INET6 roundtrip');
56 }
57
58 # sockaddr_family
59 {
60     local $@;
61     eval { sockaddr_family("") };
62     like($@, qr/^Bad arg length for Socket::sockaddr_family, length is 0, should be at least \d+/, 'sockaddr_family warns about argument length');
63 }
64
65 # pack_sockaddr_in, unpack_sockaddr_in
66 # sockaddr_in
67 {
68     my $sin = pack_sockaddr_in 100, inet_aton("10.20.30.40");
69     ok(defined $sin, 'pack_sockaddr_in defined');
70
71     is(sockaddr_family($sin), AF_INET, 'sockaddr_family of pack_sockaddr_in' );
72
73     is(          (unpack_sockaddr_in($sin))[0] , 100,           'pack_sockaddr_in->unpack_sockaddr_in port');
74     is(inet_ntoa((unpack_sockaddr_in($sin))[1]), "10.20.30.40", 'pack_sockaddr_in->unpack_sockaddr_in addr');
75
76     is(inet_ntoa(scalar unpack_sockaddr_in($sin)), "10.20.30.40", 'unpack_sockaddr_in in scalar context yields addr');
77
78     is_deeply( [ sockaddr_in($sin) ], [ unpack_sockaddr_in($sin) ],
79         'sockaddr_in in list context unpacks' );
80
81     is(sockaddr_family(scalar sockaddr_in(200,v10.30.50.70)), AF_INET,
82         'sockaddr_in in scalar context packs');
83 }
84
85 # pack_sockaddr_in6, unpack_sockaddr_in6
86 # sockaddr_in6
87 SKIP: {
88     skip "No AF_INET6", 9 unless my $AF_INET6 = eval { Socket::AF_INET6() };
89     skip "Cannot pack_sockaddr_in6()", 9 unless my $sin6 = eval { Socket::pack_sockaddr_in6(0x1234, "0123456789abcdef", 0, 89) };
90
91     ok(defined $sin6, 'pack_sockaddr_in6 defined');
92
93     is(sockaddr_family($sin6), $AF_INET6, 'sockaddr_family of pack_sockaddr_in6');
94
95     is((Socket::unpack_sockaddr_in6($sin6))[0], 0x1234,             'pack_sockaddr_in6->unpack_sockaddr_in6 port');
96     is((Socket::unpack_sockaddr_in6($sin6))[1], "0123456789abcdef", 'pack_sockaddr_in6->unpack_sockaddr_in6 addr');
97     is((Socket::unpack_sockaddr_in6($sin6))[2], 0,                  'pack_sockaddr_in6->unpack_sockaddr_in6 scope_id');
98     is((Socket::unpack_sockaddr_in6($sin6))[3], 89,                 'pack_sockaddr_in6->unpack_sockaddr_in6 flowinfo');
99
100     is(scalar Socket::unpack_sockaddr_in6($sin6), "0123456789abcdef", 'unpack_sockaddr_in6 in scalar context yields addr');
101
102     is_deeply( [ Socket::sockaddr_in6($sin6) ], [ Socket::unpack_sockaddr_in6($sin6) ],
103         'sockaddr_in6 in list context unpacks' );
104
105     is(sockaddr_family(scalar Socket::sockaddr_in6(0x1357, "02468ace13579bdf")), $AF_INET6,
106         'sockaddr_in6 in scalar context packs' );
107 }
108
109 # sockaddr_un
110 SKIP: {
111     # see if we can handle abstract sockets
112     skip "Abstract AF_UNIX paths unsupported", 2 unless $^O eq "linux";
113
114     my $test_abstract_socket = chr(0) . '/org/perl/hello'. chr(0) . 'world';
115     my $addr = sockaddr_un ($test_abstract_socket);
116     my ($path) = sockaddr_un ($addr);
117     is($path, $test_abstract_socket, 'sockaddr_un can handle abstract AF_UNIX paths');
118
119     # see if we calculate the address structure length correctly
120     is(length ($test_abstract_socket) + 2, length $addr, 'sockaddr_un abstract address length');
121 }
122
123 # warnings
124 {
125     my $w = 0;
126     local $SIG{__WARN__} = sub {
127         ++ $w if $_[0] =~ /^6-ARG sockaddr_in call is deprecated/ ;
128     };
129
130     no warnings 'Socket';
131     sockaddr_in(1,2,3,4,5,6) ;
132     is($w, 0, "sockaddr_in deprecated form doesn't warn without lexical warnings");
133
134     use warnings 'Socket';
135     sockaddr_in(1,2,3,4,5,6) ;
136     is($w, 1, "sockaddr_in deprecated form warns with lexical warnings");
137 }