diff options
| -rw-r--r-- | MANIFEST | 3 | ||||
| -rw-r--r-- | dist/IO/lib/IO/Socket.pm | 9 | ||||
| -rw-r--r-- | dist/IO/t/cachepropagate-tcp.t | 43 | ||||
| -rw-r--r-- | dist/IO/t/cachepropagate-udp.t | 27 | ||||
| -rw-r--r-- | dist/IO/t/cachepropagate-unix.t | 65 |
5 files changed, 147 insertions, 0 deletions
@@ -3247,6 +3247,9 @@ dist/IO/Makefile.PL IO extension makefile writer dist/IO/poll.c IO poll() emulation using select() dist/IO/poll.h IO poll() emulation using select() dist/IO/README IO extension maintenance notice +dist/IO/t/cachepropagate-tcp.t See if IO::Socket duplication works +dist/IO/t/cachepropagate-udp.t See if IO::Socket duplication works +dist/IO/t/cachepropagate-unix.t See if IO::Socket duplication works dist/IO/t/io_const.t See if constants from IO work dist/IO/t/io_dir.t See if directory-related methods from IO work dist/IO/t/io_dup.t See if dup()-related methods from IO work diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm index 529423b5fd..31bf56866d 100644 --- a/dist/IO/lib/IO/Socket.pm +++ b/dist/IO/lib/IO/Socket.pm @@ -349,18 +349,27 @@ sub timeout { sub sockdomain { @_ == 1 or croak 'usage: $sock->sockdomain()'; my $sock = shift; + if (!defined(${*$sock}{'io_socket_domain'})) { + my $addr = $sock->sockname(); + ${*$sock}{'io_socket_domain'} = sockaddr_family($addr) + if (defined($addr)); + } ${*$sock}{'io_socket_domain'}; } sub socktype { @_ == 1 or croak 'usage: $sock->socktype()'; my $sock = shift; + ${*$sock}{'io_socket_type'} = $sock->sockopt(Socket::SO_TYPE) + if (!defined(${*$sock}{'io_socket_type'}) && defined(eval{Socket::SO_TYPE})); ${*$sock}{'io_socket_type'} } sub protocol { @_ == 1 or croak 'usage: $sock->protocol()'; my($sock) = @_; + ${*$sock}{'io_socket_proto'} = $sock->sockopt(Socket::SO_PROTOCOL) + if (!defined(${*$sock}{'io_socket_proto'}) && defined(eval{Socket::SO_PROTOCOL})); ${*$sock}{'io_socket_proto'}; } diff --git a/dist/IO/t/cachepropagate-tcp.t b/dist/IO/t/cachepropagate-tcp.t new file mode 100644 index 0000000000..40f36be274 --- /dev/null +++ b/dist/IO/t/cachepropagate-tcp.t @@ -0,0 +1,43 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +use IO::Socket; +use IO::Socket::INET; +use Test; + +plan tests => 8; + +my $listener = IO::Socket::INET->new(Listen => 1, + LocalAddr => '127.0.0.1', + Proto => 'tcp'); +ok(defined($listener)); + +my $port = $listener->sockport(); + +my $p = $listener->protocol(); +ok(defined($p)); +my $d = $listener->sockdomain(); +ok(defined($d)); +my $s = $listener->socktype(); +ok(defined($s)); + +my $cpid = fork(); +ok(defined($cpid)); +if (0 == $cpid) { + # the child: + sleep(1); + my $connector = IO::Socket::INET->new(PeerAddr => '127.0.0.1', + PeerPort => $port, + Proto => 'tcp'); + exit(0); +}; + +my $new = $listener->accept(); + +ok($new->protocol(), $p); +ok($new->sockdomain(), $d); +ok($new->socktype(), $s); + +wait(); diff --git a/dist/IO/t/cachepropagate-udp.t b/dist/IO/t/cachepropagate-udp.t new file mode 100644 index 0000000000..04462725a0 --- /dev/null +++ b/dist/IO/t/cachepropagate-udp.t @@ -0,0 +1,27 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +use IO::Socket; +use IO::Socket::INET; +use Test; + +plan tests => 7; + +my $listener = IO::Socket::INET->new(LocalAddr => '127.0.0.1', + Proto => 'udp'); +ok(defined($listener)); + +my $p = $listener->protocol(); +ok(defined($p)); +my $d = $listener->sockdomain(); +ok(defined($d)); +my $s = $listener->socktype(); +ok(defined($s)); + +my $new = IO::Socket::INET->new_from_fd($listener->fileno(), 'r+'); + +ok($new->protocol(), $p); +ok($new->sockdomain(), $d); +ok($new->socktype(), $s); diff --git a/dist/IO/t/cachepropagate-unix.t b/dist/IO/t/cachepropagate-unix.t new file mode 100644 index 0000000000..a00897c384 --- /dev/null +++ b/dist/IO/t/cachepropagate-unix.t @@ -0,0 +1,65 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +use IO::Socket; +use IO::Socket::UNIX; +use Test; + +plan tests => 15; + +my $socketpath = './testsock'; + +# start testing stream sockets: + +my $listener = IO::Socket::UNIX->new(Type => SOCK_STREAM, + Listen => 1, + Local => $socketpath); +ok(defined($listener)); + +my $p = $listener->protocol(); +ok(defined($p)); +my $d = $listener->sockdomain(); +ok(defined($d)); +my $s = $listener->socktype(); +ok(defined($s)); + +my $cpid = fork(); +ok(defined($cpid)); +if (0 == $cpid) { + # the child: + sleep(1); + my $connector = IO::Socket::UNIX->new(Peer => $socketpath); + exit(0); +}; + +my $new = $listener->accept(); + +ok($new->protocol(), $p); +ok($new->sockdomain(), $d); +ok($new->socktype(), $s); + +unlink($socketpath); +wait(); + +# now test datagram sockets: + +$listener = IO::Socket::UNIX->new(Type => SOCK_DGRAM, + Local => $socketpath); +ok(defined($listener)); + +$p = $listener->protocol(); +ok(defined($p)); +$d = $listener->sockdomain(); +ok(defined($d)); +$s = $listener->socktype(); +ok(defined($s)); + +$new = IO::Socket::UNIX->new_from_fd($listener->fileno(), 'r+'); + +ok($new->protocol(), $p); +ok($new->sockdomain(), $d); +ok($new->socktype(), $s); + +unlink($socketpath); |