=== modified file 'lib/IO/Poll.pm'
--- lib/IO/Poll.pm 2014-02-20 17:42:18 +0000
+++ lib/IO/Poll.pm 2014-02-20 18:01:49 +0000
@@ -10,6 +10,7 @@
use strict;
use IO::Handle;
use Exporter ();
+use Scalar::Util qw( refaddr );
our(@ISA, @EXPORT_OK, @EXPORT, $VERSION);
@ISA = qw(Exporter);
@@ -31,9 +32,9 @@
POLLNORM
);
-# [0] maps fd's to requested masks
+# [0] maps fd's to hashes that map handles to requested masks
# [1] maps fd's to returned masks
-# [2] maps fd's to handles
+# [2] maps handle addrs to handles
sub new {
my $class = shift;
@@ -50,22 +51,22 @@
if (@_) {
my $mask = shift;
if($mask) {
- $self->[0]{$fd}{$io} = $mask; # the error events are always returned
- $self->[1]{$fd} = 0; # output mask
- $self->[2]{$io} = $io; # remember handle
+ $self->[0]{$fd}{refaddr $io} = $mask; # the error events are always returned
+ $self->[1]{$fd} = 0; # output mask
+ $self->[2]{refaddr $io} = $io; # remember handle
} else {
- delete $self->[0]{$fd}{$io};
+ delete $self->[0]{$fd}{refaddr $io};
unless(%{$self->[0]{$fd}}) {
# We no longer have any handles for this FD
delete $self->[1]{$fd};
delete $self->[0]{$fd};
}
- delete $self->[2]{$io};
+ delete $self->[2]{refaddr $io};
}
}
- return unless exists $self->[0]{$fd} and exists $self->[0]{$fd}{$io};
- return $self->[0]{$fd}{$io};
+ return unless exists $self->[0]{$fd} and exists $self->[0]{$fd}{refaddr $io};
+ return $self->[0]{$fd}{refaddr $io};
}
@@ -100,8 +101,8 @@
my $self = shift;
my $io = shift;
my $fd = fileno($io);
- exists $self->[1]{$fd} and exists $self->[0]{$fd}{$io}
- ? $self->[1]{$fd} & ($self->[0]{$fd}{$io}|POLLHUP|POLLERR|POLLNVAL)
+ exists $self->[1]{$fd} and exists $self->[0]{$fd}{refaddr $io}
+ ? $self->[1]{$fd} & ($self->[0]{$fd}{refaddr $io}|POLLHUP|POLLERR|POLLNVAL)
: 0;
}
=== added file 't/rt93107.t'
--- t/rt93107.t 1970-01-01 00:00:00 +0000
+++ t/rt93107.t 2014-02-20 18:01:49 +0000
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+
+# Regression test for
https://rt.cpan.org/Ticket/Display.html?id=93107
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use IO::Poll;
+
+use IO::Handle;
+
+package NewIOHandle {
+ use base qw( IO::Handle );
+}
+
+pipe( my $rd, my $wr ) or die "Cannot pipe() - $!";
+$wr->syswrite( "data\n" );
+# $rd should now be readable
+
+my $poll = IO::Poll->new;
+$poll->mask( $rd, POLLIN );
+
+my $ret = $poll->poll( 0 );
+is( $ret, 1, 'poll() indicates 1 filehandle is ready' );
+is( $poll->events( $rd ), POLLIN, 'poll() indicates $rd has POLLIN' );
+
+bless $rd, "NewIOHandle";
+
+is( $poll->mask( $rd ), POLLIN, '$poll still has POLLIN mask for reblessed handle' );
+$ret = $poll->poll( 0 );
+is( $ret, 1, 'poll() indicates 1 filehandle is ready after rebless' );
+is( $poll->events( $rd ), POLLIN, 'poll() indicates reblessed $rd still has POLLIN' );
+
+$poll->remove( $rd );
+$rd->close;
+
+$ret = $poll->poll( 0 );
+is( $ret, 0, 'poll() times out after remove' );
+
+done_testing;
