1N/A#!./perl
1N/A
1N/ABEGIN {
1N/A unless(grep /blib/, @INC) {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A }
1N/A}
1N/A
1N/Aselect(STDERR); $| = 1;
1N/Aselect(STDOUT); $| = 1;
1N/A
1N/Aprint "1..23\n";
1N/A
1N/Ause IO::Select 1.09;
1N/A
1N/Amy $sel = new IO::Select(\*STDIN);
1N/A$sel->add(4, 5) == 2 or print "not ";
1N/Aprint "ok 1\n";
1N/A
1N/A$sel->add([\*STDOUT, 'foo']) == 1 or print "not ";
1N/Aprint "ok 2\n";
1N/A
1N/A@handles = $sel->handles;
1N/Aprint "not " unless $sel->count == 4 && @handles == 4;
1N/Aprint "ok 3\n";
1N/A#print $sel->as_string, "\n";
1N/A
1N/A$sel->remove(\*STDIN) == 1 or print "not ";
1N/Aprint "ok 4\n",
1N/A;
1N/A$sel->remove(\*STDIN, 5, 6) == 1 # two of there are not present
1N/A or print "not ";
1N/Aprint "ok 5\n";
1N/A
1N/Aprint "not " unless $sel->count == 2;
1N/Aprint "ok 6\n";
1N/A#print $sel->as_string, "\n";
1N/A
1N/A$sel->remove(1, 4);
1N/Aprint "not " unless $sel->count == 0 && !defined($sel->bits);
1N/Aprint "ok 7\n";
1N/A
1N/A$sel = new IO::Select;
1N/Aprint "not " unless $sel->count == 0 && !defined($sel->bits);
1N/Aprint "ok 8\n";
1N/A
1N/A$sel->remove([\*STDOUT, 5]);
1N/Aprint "not " unless $sel->count == 0 && !defined($sel->bits);
1N/Aprint "ok 9\n";
1N/A
1N/Aif ( grep $^O eq $_, qw(MSWin32 NetWare dos VMS riscos beos) ) {
1N/A for (10 .. 15) {
1N/A print "ok $_ # skip: 4-arg select is only valid on sockets\n"
1N/A }
1N/A $sel->add(\*STDOUT); # update
1N/A goto POST_SOCKET;
1N/A}
1N/A
1N/A@a = $sel->can_read(); # should return imediately
1N/Aprint "not " unless @a == 0;
1N/Aprint "ok 10\n";
1N/A
1N/A# we assume that we can write to STDOUT :-)
1N/A$sel->add([\*STDOUT, "ok 12\n"]);
1N/A
1N/A@a = $sel->can_write;
1N/Aprint "not " unless @a == 1;
1N/Aprint "ok 11\n";
1N/A
1N/Amy($fd, $msg) = @{shift @a};
1N/Aprint $fd $msg;
1N/A
1N/A$sel->add(\*STDOUT); # update
1N/A
1N/A@a = IO::Select::select(undef, $sel, undef, 1);
1N/Aprint "not " unless @a == 3;
1N/Aprint "ok 13\n";
1N/A
1N/A($r, $w, $e) = @a;
1N/A
1N/Aprint "not " unless @$r == 0 && @$w == 1 && @$e == 0;
1N/Aprint "ok 14\n";
1N/A
1N/A$fd = $w->[0];
1N/Aprint $fd "ok 15\n";
1N/A
1N/APOST_SOCKET:
1N/A# Test new exists() method
1N/A$sel->exists(\*STDIN) and print "not ";
1N/Aprint "ok 16\n";
1N/A
1N/A($sel->exists(0) || $sel->exists([\*STDERR])) and print "not ";
1N/Aprint "ok 17\n";
1N/A
1N/A$fd = $sel->exists(\*STDOUT);
1N/Aif ($fd) {
1N/A print $fd "ok 18\n";
1N/A} else {
1N/A print "not ok 18\n";
1N/A}
1N/A
1N/A$fd = $sel->exists([1, 'foo']);
1N/Aif ($fd) {
1N/A print $fd "ok 19\n";
1N/A} else {
1N/A print "not ok 19\n";
1N/A}
1N/A
1N/A# Try self clearing
1N/A$sel->add(5,6,7,8,9,10);
1N/Aprint "not " unless $sel->count == 7;
1N/Aprint "ok 20\n";
1N/A
1N/A$sel->remove($sel->handles);
1N/Aprint "not " unless $sel->count == 0 && !defined($sel->bits);
1N/Aprint "ok 21\n";
1N/A
1N/A# check warnings
1N/A$SIG{__WARN__} = sub {
1N/A ++ $w
1N/A if $_[0] =~ /^Call to deprecated method 'has_error', use 'has_exception'/
1N/A } ;
1N/A$w = 0 ;
1N/AIO::Select::has_error();
1N/Aprint "not " unless $w == 0 ;
1N/A$w = 0 ;
1N/Aprint "ok 22\n" ;
1N/Ause warnings 'IO::Select' ;
1N/AIO::Select::has_error();
1N/Aprint "not " unless $w == 1 ;
1N/A$w = 0 ;
1N/Aprint "ok 23\n" ;