1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
#!./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" ;
|
