t/lib/io_poll.t

   1 #!./perl
   2
   3 BEGIN {
   4     unless(grep /blib/, @INC) {
   5         chdir 't' if -d 't';
   6         @INC = '../lib';
   7     }
   8 }
   9
  10 if ($^O eq 'mpeix') {
  11     print "1..0 # Skip: broken on MPE/iX\n";
  12     exit 0;
  13 }
  14
  15 select(STDERR); $| = 1;
  16 select(STDOUT); $| = 1;
  17
  18 print "1..9\n";
  19
  20 use IO::Handle;
  21 use IO::Poll qw(/POLL/);
  22
  23 my $poll = new IO::Poll;
  24
  25 my $stdout = \*STDOUT;
  26 my $dupout = IO::Handle->new_from_fd(fileno($stdout),"w");
  27
  28 $poll->mask($stdout => POLLOUT);
  29
  30 print "not "
  31         unless $poll->mask($stdout) == POLLOUT;
  32 print "ok 1\n";
  33
  34 $poll->mask($dupout => POLLPRI);
  35
  36 print "not "
  37         unless $poll->mask($dupout) == POLLPRI;
  38 print "ok 2\n";
  39
  40 $poll->poll(0.1);
  41
  42 if ($^O eq 'MSWin32') {
  43 print "ok 3 # skipped, doesn't work on non-socket fds\n";
  44 print "ok 4 # skipped, doesn't work on non-socket fds\n";
  45 }
  46 else {
  47 print "not "
  48         unless $poll->events($stdout) == POLLOUT;
  49 print "ok 3\n";
  50
  51 print "not "
  52         if $poll->events($dupout);
  53 print "ok 4\n";
  54 }
  55
  56 my @h = $poll->handles;
  57 print "not "
  58         unless @h == 2;
  59 print "ok 5\n";
  60
  61 $poll->remove($stdout);
  62
  63 @h = $poll->handles;
  64
  65 print "not "
  66         unless @h == 1;
  67 print "ok 6\n";
  68
  69 print "not "
  70         if $poll->mask($stdout);
  71 print "ok 7\n";
  72
  73 $poll->poll(0.1);
  74
  75 print "not "
  76         if $poll->events($stdout);
  77 print "ok 8\n";
  78
  79 $poll->remove($dupout);
  80 print "not "
  81     if $poll->handles;
  82 print "ok 9\n";