Skip Menu |
 

This queue is for tickets about the IO CPAN distribution.

Report information
The Basics
Id: 77740
Status: resolved
Priority: 0/
Queue: IO

People
Owner: Nobody in particular
Requestors: bitcard [...] stormcloud9.net
Cc:
AdminCc:

Bug Information
Severity: Normal
Broken in: 1.25
Fixed in: (no value)



Subject: IO::Select can't remove closed socket
Download (untitled) / with headers
text/plain 457b
If an IO::Socket handle is closed before removing it from the IO::Select object, IO::Select is unable to remove it. use IO::Socket; use IO::Select; my $sock = IO::Socket::INET->new('PeerAddr' => 'google.com', 'PeerPort' => 80, 'Proto' => 'tcp'); my $ios = IO::Select->new(); $ios->add($sock); close($sock); print("Removing handle $sock\n"); $ios->remove($sock); # <-- this does not work print("Remaining handles: " . join(" ", $ios->handles()) . "\n");
Download (untitled) / with headers
text/plain 207b
On Sat Jun 09 19:13:45 2012, qubit wrote: Show quoted text
> If an IO::Socket handle is closed before removing it from the IO::Select > object, IO::Select is unable to remove it.
Attached patch fixes this. -- Paul Evans
Subject: rt77740.patch
Download rt77740.patch
text/x-diff 1.3k
=== modified file 'lib/IO/Select.pm' --- lib/IO/Select.pm 2014-02-20 17:42:18 +0000 +++ lib/IO/Select.pm 2014-02-20 18:27:02 +0000 @@ -58,7 +58,21 @@ my($self, $f) = @_; return unless defined $f; $f = $f->[0] if ref($f) eq 'ARRAY'; - ($f =~ /^\d+$/) ? $f : fileno($f); + if($f =~ /^\d+$/) { # plain file number + return $f; + } + elsif(defined(my $fd = fileno($f))) { + return $fd; + } + else { + # Neither a plain file number nor an opened filehandle; but maybe it was + # previously registered and has since been closed. ->remove still wants to + # know what fileno it had + foreach my $i ( FIRST_FD .. $#$self ) { + return $i - FIRST_FD if $self->[$i] == $f; + } + return undef; + } } sub _update === added file 't/rt77740.t' --- t/rt77740.t 1970-01-01 00:00:00 +0000 +++ t/rt77740.t 2014-02-20 18:27:02 +0000 @@ -0,0 +1,28 @@ +#!/usr/bin/perl + +# Regression test for https://rt.cpan.org/Ticket/Display.html?id=77740 + +use strict; +use warnings; + +use Test::More; + +use IO::Select; + +use IO::Handle; + +pipe( my $rd, my $wr ) or die "Cannot pipe() - $!"; +$wr->syswrite( "data\n" ); + +my $select = IO::Select->new(); +$select->add( $rd ); + +is( scalar $select->handles, 1, '$select has 1 handle' ); + +# close first, then remove afterwards +$rd->close; +$select->remove( $rd ); + +is( scalar $select->handles, 0, '$select has 0 handles' ); + +done_testing;
Ticket migrated to github as https://github.com/toddr/IO/issues/43


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.