1#!./perl 2 3BEGIN { 4 unless(grep /blib/, @INC) { 5 chdir 't' if -d 't'; 6 @INC = '../lib'; 7 } 8} 9 10select(STDERR); $| = 1; 11select(STDOUT); $| = 1; 12 13print "1..23\n"; 14 15use IO::Select 1.09; 16 17my $sel = new IO::Select(\*STDIN); 18$sel->add(4, 5) == 2 or print "not "; 19print "ok 1\n"; 20 21$sel->add([\*STDOUT, 'foo']) == 1 or print "not "; 22print "ok 2\n"; 23 24@handles = $sel->handles; 25print "not " unless $sel->count == 4 && @handles == 4; 26print "ok 3\n"; 27#print $sel->as_string, "\n"; 28 29$sel->remove(\*STDIN) == 1 or print "not "; 30print "ok 4\n", 31; 32$sel->remove(\*STDIN, 5, 6) == 1 # two of there are not present 33 or print "not "; 34print "ok 5\n"; 35 36print "not " unless $sel->count == 2; 37print "ok 6\n"; 38#print $sel->as_string, "\n"; 39 40$sel->remove(1, 4); 41print "not " unless $sel->count == 0 && !defined($sel->bits); 42print "ok 7\n"; 43 44$sel = new IO::Select; 45print "not " unless $sel->count == 0 && !defined($sel->bits); 46print "ok 8\n"; 47 48$sel->remove([\*STDOUT, 5]); 49print "not " unless $sel->count == 0 && !defined($sel->bits); 50print "ok 9\n"; 51 52if ( grep $^O eq $_, qw(MSWin32 NetWare dos VMS riscos beos) ) { 53 for (10 .. 15) { 54 print "ok $_ # skip: 4-arg select is only valid on sockets\n" 55 } 56 $sel->add(\*STDOUT); # update 57 goto POST_SOCKET; 58} 59 60@a = $sel->can_read(); # should return imediately 61print "not " unless @a == 0; 62print "ok 10\n"; 63 64# we assume that we can write to STDOUT :-) 65$sel->add([\*STDOUT, "ok 12\n"]); 66 67@a = $sel->can_write; 68print "not " unless @a == 1; 69print "ok 11\n"; 70 71my($fd, $msg) = @{shift @a}; 72print $fd $msg; 73 74$sel->add(\*STDOUT); # update 75 76@a = IO::Select::select(undef, $sel, undef, 1); 77print "not " unless @a == 3; 78print "ok 13\n"; 79 80($r, $w, $e) = @a; 81 82print "not " unless @$r == 0 && @$w == 1 && @$e == 0; 83print "ok 14\n"; 84 85$fd = $w->[0]; 86print $fd "ok 15\n"; 87 88POST_SOCKET: 89# Test new exists() method 90$sel->exists(\*STDIN) and print "not "; 91print "ok 16\n"; 92 93($sel->exists(0) || $sel->exists([\*STDERR])) and print "not "; 94print "ok 17\n"; 95 96$fd = $sel->exists(\*STDOUT); 97if ($fd) { 98 print $fd "ok 18\n"; 99} else { 100 print "not ok 18\n"; 101} 102 103$fd = $sel->exists([1, 'foo']); 104if ($fd) { 105 print $fd "ok 19\n"; 106} else { 107 print "not ok 19\n"; 108} 109 110# Try self clearing 111$sel->add(5,6,7,8,9,10); 112print "not " unless $sel->count == 7; 113print "ok 20\n"; 114 115$sel->remove($sel->handles); 116print "not " unless $sel->count == 0 && !defined($sel->bits); 117print "ok 21\n"; 118 119# check warnings 120$SIG{__WARN__} = sub { 121 ++ $w 122 if $_[0] =~ /^Call to deprecated method 'has_error', use 'has_exception'/ 123 } ; 124$w = 0 ; 125IO::Select::has_error(); 126print "not " unless $w == 0 ; 127$w = 0 ; 128print "ok 22\n" ; 129use warnings 'IO::Select' ; 130IO::Select::has_error(); 131print "not " unless $w == 1 ; 132$w = 0 ; 133print "ok 23\n" ; 134