diff options
Diffstat (limited to 'contrib/perl5/t/lib/io_sel.t')
-rwxr-xr-x | contrib/perl5/t/lib/io_sel.t | 132 |
1 files changed, 0 insertions, 132 deletions
diff --git a/contrib/perl5/t/lib/io_sel.t b/contrib/perl5/t/lib/io_sel.t deleted file mode 100755 index 5d1dce3..0000000 --- a/contrib/perl5/t/lib/io_sel.t +++ /dev/null @@ -1,132 +0,0 @@ -#!./perl - -BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - -select(STDERR); $| = 1; -select(STDOUT); $| = 1; - -print "1..23\n"; - -use IO::Select 1.09; - -my $sel = new IO::Select(\*STDIN); -$sel->add(4, 5) == 2 or print "not "; -print "ok 1\n"; - -$sel->add([\*STDOUT, 'foo']) == 1 or print "not "; -print "ok 2\n"; - -@handles = $sel->handles; -print "not " unless $sel->count == 4 && @handles == 4; -print "ok 3\n"; -#print $sel->as_string, "\n"; - -$sel->remove(\*STDIN) == 1 or print "not "; -print "ok 4\n", -; -$sel->remove(\*STDIN, 5, 6) == 1 # two of there are not present - or print "not "; -print "ok 5\n"; - -print "not " unless $sel->count == 2; -print "ok 6\n"; -#print $sel->as_string, "\n"; - -$sel->remove(1, 4); -print "not " unless $sel->count == 0 && !defined($sel->bits); -print "ok 7\n"; - -$sel = new IO::Select; -print "not " unless $sel->count == 0 && !defined($sel->bits); -print "ok 8\n"; - -$sel->remove([\*STDOUT, 5]); -print "not " unless $sel->count == 0 && !defined($sel->bits); -print "ok 9\n"; - -if ($^O eq 'MSWin32' || $^O eq 'dos') { # 4-arg select is only valid on sockets - print "# skipping tests 10..15\n"; - for (10 .. 15) { print "ok $_\n" } - $sel->add(\*STDOUT); # update - goto POST_SOCKET; -} - -@a = $sel->can_read(); # should return imediately -print "not " unless @a == 0; -print "ok 10\n"; - -# we assume that we can write to STDOUT :-) -$sel->add([\*STDOUT, "ok 12\n"]); - -@a = $sel->can_write; -print "not " unless @a == 1; -print "ok 11\n"; - -my($fd, $msg) = @{shift @a}; -print $fd $msg; - -$sel->add(\*STDOUT); # update - -@a = IO::Select::select(undef, $sel, undef, 1); -print "not " unless @a == 3; -print "ok 13\n"; - -($r, $w, $e) = @a; - -print "not " unless @$r == 0 && @$w == 1 && @$e == 0; -print "ok 14\n"; - -$fd = $w->[0]; -print $fd "ok 15\n"; - -POST_SOCKET: -# Test new exists() method -$sel->exists(\*STDIN) and print "not "; -print "ok 16\n"; - -($sel->exists(0) || $sel->exists([\*STDERR])) and print "not "; -print "ok 17\n"; - -$fd = $sel->exists(\*STDOUT); -if ($fd) { - print $fd "ok 18\n"; -} else { - print "not ok 18\n"; -} - -$fd = $sel->exists([1, 'foo']); -if ($fd) { - print $fd "ok 19\n"; -} else { - print "not ok 19\n"; -} - -# Try self clearing -$sel->add(5,6,7,8,9,10); -print "not " unless $sel->count == 7; -print "ok 20\n"; - -$sel->remove($sel->handles); -print "not " unless $sel->count == 0 && !defined($sel->bits); -print "ok 21\n"; - -# check warnings -$SIG{__WARN__} = sub { - ++ $w - if $_[0] =~ /^Call to depreciated method 'has_error', use 'has_exception'/ - } ; -$w = 0 ; -IO::Select::has_error(); -print "not " unless $w == 0 ; -$w = 0 ; -print "ok 22\n" ; -use warnings 'IO::Select' ; -IO::Select::has_error(); -print "not " unless $w == 1 ; -$w = 0 ; -print "ok 23\n" ; |