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