The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*-perl-*- i/o

use Config;
BEGIN {
    if ($^O eq 'MSWin32') {
	print "1..0 # skipped; Win32 supports select() only on sockets\n";
	exit;
    }
}

use Test; plan tests => 8;
use Event qw(loop unloop);
use Event::Watcher qw(R W);
use Symbol;

#$Event::DebugLevel = 3;

eval { Event->io };
ok $@, "/nothing to watch/";

eval { Event->io(fd => \*STDIN, cb => \&die, poll => 0) };
ok $@, "/nothing to watch/";

my $cannot_detect_bogus_fd;
if ($Config{osname} eq 'darwin' or $Config{osname} eq 'gnu' or
    $Config{archname} =~ m/^armv5tejl/) {
    # GNU/Hurd's poll returns with -EBADF which is accurate
    # but we cannot determine which fd is bad.
    $cannot_detect_bogus_fd = 'Cannot detect bogus file descriptors';
}

my $noticed_bogus_fd=0;
my $bogus_timeout=0;
my $bogus;
if (!$cannot_detect_bogus_fd) {
    $bogus = Event->io(desc => 'oops', poll => 'r', fd => 123,
		      timeout => .1, cb => sub {
			  ++$bogus_timeout;
		      });
}

$SIG{__WARN__} = sub {
    my $is_it = $_[0] =~ m/\'oops\' was unexpectedly/;
    if ($is_it) {
	++$noticed_bogus_fd;
    } else {
	warn $_[0]
    }
};

sub new_pipe {
    my ($cnt) = @_;
    my ($r,$w) = (gensym, gensym);
    pipe($r,$w);

    Event->io(desc => "r", poll => 'r', fd => $r, cb => sub {
		  my $e = shift;
		  my $w=$e->w;
		  if ($e->got & R) {
		      my $buf;
		      my $got = sysread $w->fd, $buf, 1;
		      die "sysread: $!"
			  if !defined $got;
		      die "sysread: pipe closed?"
			  if $got == 0;
		      ++$$cnt;
		  }
	      });
    Event->io(desc => 'w', poll => 'w', fd => $w, cb => sub {
		  my $e = shift;
		  my $w=$e->w;
		  if ($e->got & W) {
		      my $got = syswrite $w->fd, '.', 1;
		      die "syswrite: $!"
			  if !defined $got;
		      die "syswrite: pipe closed?"
			  if $got == 0;
		  }
	      });
}

my $count = 0;
new_pipe(\$count);

my $hit=0;
my $once = Event->io(timeout => .01, repeat => 0, cb => sub { ++$hit });

Event->io(timeout => 2, repeat => 0,
	  cb => sub {
	      ok $count > 0;
	      ok $hit, 1;
	      ok $once->timeout, 0;
	      unloop;
	  });

loop();

skip $cannot_detect_bogus_fd, $noticed_bogus_fd, 1;
skip $cannot_detect_bogus_fd, $bogus && !defined $bogus->fd;
skip $cannot_detect_bogus_fd, $bogus_timeout > 0;