This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[rt.cpan.org #61577] propagate socket details on accept
authorTony Cook <tony@develop-help.com>
Wed, 13 Jun 2012 09:32:33 +0000 (19:32 +1000)
committerTony Cook <tony@develop-help.com>
Mon, 2 Jul 2012 08:23:05 +0000 (18:23 +1000)
dist/IO/lib/IO/Socket.pm
dist/IO/t/cachepropagate-tcp.t
dist/IO/t/cachepropagate-unix.t

index 529423b..5d4b19e 100644 (file)
@@ -249,6 +249,8 @@ sub accept {
     $peer = accept($new,$sock)
        or return;
 
+    ${*$new}{$_} = ${*$sock}{$_} for qw( io_socket_domain io_socket_type io_socket_proto );
+
     return wantarray ? ($new, $peer)
                     : $new;
 }
index 6bc2efe..b9104bb 100644 (file)
@@ -43,7 +43,6 @@ SKIP: {
 
     my $new = $listener->accept();
 
-    local $TODO = "this information isn't cached for accepted sockets";
     is($new->sockdomain(), $d, 'domain match');
   SKIP: {
       skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });
index 3e3a73a..2f8c55e 100644 (file)
@@ -47,7 +47,6 @@ SKIP: {
 
     my $new = $listener->accept();
 
-    $TODO = "this information isn't cached for accepted sockets";
     is($new->sockdomain(), $d, 'domain match');
   SKIP: {
       skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });