IO::Poll bugs fixed (from Lincoln Stein <lstein@cshl.org>)

p4raw-id: //depot/perl@6009

1 files changed, 36 insertions, 37 deletions

diff --git a/ext/IO/lib/IO/Poll.pm b/ext/IO/lib/IO/Poll.pm
index 687664b9ab..70a3469edb 100644
--- a/ext/IO/lib/IO/Poll.pm
+++ b/ext/IO/lib/IO/Poll.pm
@@ -1,3 +1,4 @@
+
 # IO::Poll.pm
 #
 # Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
@@ -12,28 +13,31 @@ use Exporter ();
 our(@ISA, @EXPORT_OK, @EXPORT, $VERSION);
 
 @ISA = qw(Exporter);
-$VERSION = "0.01";
+$VERSION = "0.05";
 
-@EXPORT = qw(poll);
+@EXPORT = qw( POLLIN
+	      POLLOUT
+	      POLLERR
+	      POLLHUP
+	      POLLNVAL
+	    );
 
 @EXPORT_OK = qw(
- POLLIN    
  POLLPRI   
- POLLOUT   
  POLLRDNORM
  POLLWRNORM
  POLLRDBAND
  POLLWRBAND
  POLLNORM  
- POLLERR   
- POLLHUP   
- POLLNVAL  
-);
+	       );
 
+# [0] maps fd's to requested masks
+# [1] maps fd's to returned  masks
+# [2] maps fd's to handles
 sub new {
     my $class = shift;
 
-    my $self = bless [{},{}], $class;
+    my $self = bless [{},{},{}], $class;
 
     $self;
 }
@@ -42,20 +46,21 @@ sub mask {
     my $self = shift;
     my $io = shift;
     my $fd = fileno($io);
-    if(@_) {
+    if (@_) {
 	my $mask = shift;
-	$self->[0]{$fd} ||= {};
 	if($mask) {
-	    $self->[0]{$fd}{$io} = $mask;
-	}
-	else {
+	  $self->[0]{$fd}{$io} = $mask; # the error events are always returned
+	  $self->[1]{$fd}      = 0;     # output mask
+	  $self->[2]{$io}      = $io;   # remember handle
+	} else {
 	    delete $self->[0]{$fd}{$io};
+	  delete $self->[1]{$fd} unless %{$self->[0]{$fd}};
+	  delete $self->[2]{$io};
 	}
     }
-    elsif(exists $self->[0]{$fd}{$io}) {
+    
+    return unless exists $self->[0]{$fd} and exists $self->[0]{$fd}{$io};
 	return $self->[0]{$fd}{$io};
-    }
-    return;
 }
 
 
@@ -64,13 +69,13 @@ sub poll {
 
     $self->[1] = {};
 
-    my($fd,$ref);
+    my($fd,$mask,$iom);
     my @poll = ();
 
-    while(($fd,$ref) = each %{$self->[0]}) {
-	my $events = 0;
-	map { $events |= $_ } values %{$ref};
-	push(@poll,$fd, $events);
+    while(($fd,$iom) = each %{$self->[0]}) {
+	$mask   = 0;
+	$mask  |= $_ for values(%$iom);
+	push(@poll,$fd => $mask);
     }
 
     my $ret = @poll ? _poll(defined($timeout) ? $timeout * 1000 : -1,@poll) : 0;
@@ -80,8 +85,7 @@ sub poll {
 
     while(@poll) {
 	my($fd,$got) = splice(@poll,0,2);
-	$self->[1]{$fd} = $got
-	    if $got;
+	$self->[1]{$fd} = $got if $got;
     }
 
     return $ret;  
@@ -91,9 +95,8 @@ sub events {
     my $self = shift;
     my $io = shift;
     my $fd = fileno($io);
-
-    exists $self->[1]{$fd} && exists $self->[0]{$fd}{$io}
-	? $self->[1]{$fd} & $self->[0]{$fd}{$io}
+    exists $self->[1]{$fd} and exists $self->[0]{$fd}{$io} 
+                ? $self->[1]{$fd} & ($self->[0]{$fd}{$io}|POLLHUP|POLLERR|POLLNVAL)
 	: 0;
 }
 
@@ -105,20 +108,16 @@ sub remove {
 
 sub handles {
     my $self = shift;
-
-    return map { keys %$_ } values %{$self->[0]}
-	unless(@_);
+    return values %{$self->[2]} unless @_;
 
     my $events = shift || 0;
     my($fd,$ev,$io,$mask);
     my @handles = ();
 
     while(($fd,$ev) = each %{$self->[1]}) {
-	if($ev & $events) {
-	    while(($io,$mask) = each %{$self->[0][$fd]}) {
-		push(@handles, $io)
-		    if $events & $mask;
-	    }
+	while (($io,$mask) = each %{$self->[0]{$fd}}) {
+	    $mask |= POLLHUP|POLLERR|POLLNVAL;  # must allow these
+	    push @handles,$self->[2]{$io} if ($ev & $mask) & $events;
 	}
     }
     return @handles;
@@ -138,8 +137,8 @@ IO::Poll - Object interface to system poll call
 
     $poll = new IO::Poll;
 
-    $poll->mask($input_handle => POLLRDNORM | POLLIN | POLLHUP);
-    $poll->mask($output_handle => POLLWRNORM);
+    $poll->mask($input_handle => POLLIN);
+    $poll->mask($output_handle => POLLOUT);
 
     $poll->poll($timeout);