Bug #77726 for IO-Socket-IP: Non-blocking IO::Socket::IP does not connect on instantiation

On Fri Jun 08 19:14:00 2012, SRI wrote: Show quoted text
The attached patch should fix this. $ $ perl -Mblib -MIO::Socket::IP -E 'say IO::Socket::IP->new(Blocking => 0, PeerAddr => "mojolicio.us", PeerPort => 80)->fileno' 3 Will be in 0.12. -- Paul Evans

=== modified file 'lib/IO/Socket/IP.pm' --- lib/IO/Socket/IP.pm 2012-06-01 15:49:20 +0000 +++ lib/IO/Socket/IP.pm 2012-06-14 11:24:40 +0000 @@ -520,9 +520,9 @@ ${*$self}{io_socket_ip_errors} = [ undef, undef, undef ]; - if( $blocking ) { - $self->setup or return undef; - } + # ->setup is allowed to return false in nonblocking mode + $self->setup or !$blocking or return undef; + return $self; } @@ -594,11 +594,15 @@ return CORE::connect( $self, $_[0] ) if @_; - $! = 0, return 1 if $self->fileno and defined $self->peername; - if( $self->fileno ) { - # A connect has just failed, get its error value - ${*$self}{io_socket_ip_errors}[0] = $self->getsockopt( SOL_SOCKET, SO_ERROR ); + # A connect call may have just finished. It succeeded if we have a peername + $! = 0, return 1 if defined $self->peername; + + # If not, it may have just failed. Get its error value + my $errno = ${*$self}{io_socket_ip_errors}[0] = $self->getsockopt( SOL_SOCKET, SO_ERROR ); + + # If errno is 0 then it hasn't failed yet, so keep polling + $! = EINPROGRESS, return 0 if !$errno; } return $self->setup; === modified file 't/20nonblocking-connect.t' --- t/20nonblocking-connect.t 2011-10-17 13:45:03 +0000 +++ t/20nonblocking-connect.t 2012-06-14 11:24:40 +0000 @@ -1,7 +1,7 @@ #!/usr/bin/perl -w use strict; -use Test::More tests => 8; +use Test::More tests => 9; use IO::Socket::IP; @@ -24,6 +24,8 @@ ok( defined $socket, 'IO::Socket::IP->new( Blocking => 0 ) constructs a socket' ) or diag( " error was $@" ); +ok( defined $socket->fileno, '$socket has a fileno immediately after construction' ); + while( !$socket->connect and ( $! == EINPROGRESS || $! == EWOULDBLOCK ) ) { my $wvec = ''; vec( $wvec, fileno $socket, 1 ) = 1; === modified file 't/21nonblocking-connect-internet.t' --- t/21nonblocking-connect-internet.t 2011-10-17 13:45:03 +0000 +++ t/21nonblocking-connect-internet.t 2012-06-14 11:24:40 +0000 @@ -1,7 +1,7 @@ #!/usr/bin/perl -w use strict; -use Test::More tests => 10; +use Test::More tests => 12; use IO::Socket::IP; @@ -30,6 +30,8 @@ ok( defined $socket, "defined \$socket for $test_host:$test_good_port" ) or diag( " error was $@" ); + ok( defined $socket->fileno, '$socket has fileno' ); + # This and test is required to placate a warning IO::Socket would otherwise # throw; https://rt.cpan.org/Ticket/Display.html?id=63052 ok( not( $socket->opened and $socket->connected ), '$socket not yet connected' ); @@ -72,6 +74,8 @@ ok( defined $socket, "defined \$socket for $test_host:$test_bad_port" ) or diag( " error was $@" ); + ok( defined $socket->fileno, '$socket has fileno' ); + ok( not( $socket->opened and $socket->connected ), '$socket not yet connected' ); my $selectcount = 0;