Commit | Line | Data |
7a4c00b4 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | unless(grep /blib/, @INC) { |
5 | chdir 't' if -d 't'; |
20822f61 |
6 | @INC = '../lib'; |
7a4c00b4 |
7 | } |
8 | } |
9 | |
10 | select(STDERR); $| = 1; |
11 | select(STDOUT); $| = 1; |
12 | |
d3a7d8c7 |
13 | print "1..23\n"; |
7a4c00b4 |
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 | |
4024c853 |
52 | if ( grep $^O eq $_, qw(MSWin32 NetWare dos VMS riscos beos) ) { |
05f4e11e |
53 | for (10 .. 15) { |
54 | print "ok $_ # skip: 4-arg select is only valid on sockets\n" |
55 | } |
68dc0745 |
56 | $sel->add(\*STDOUT); # update |
57 | goto POST_SOCKET; |
58 | } |
59 | |
7a4c00b4 |
60 | @a = $sel->can_read(); # should return imediately |
61 | print "not " unless @a == 0; |
62 | print "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; |
68 | print "not " unless @a == 1; |
69 | print "ok 11\n"; |
70 | |
71 | my($fd, $msg) = @{shift @a}; |
72 | print $fd $msg; |
73 | |
74 | $sel->add(\*STDOUT); # update |
75 | |
76 | @a = IO::Select::select(undef, $sel, undef, 1); |
77 | print "not " unless @a == 3; |
78 | print "ok 13\n"; |
79 | |
80 | ($r, $w, $e) = @a; |
81 | |
82 | print "not " unless @$r == 0 && @$w == 1 && @$e == 0; |
83 | print "ok 14\n"; |
84 | |
85 | $fd = $w->[0]; |
86 | print $fd "ok 15\n"; |
87 | |
68dc0745 |
88 | POST_SOCKET: |
7a4c00b4 |
89 | # Test new exists() method |
90 | $sel->exists(\*STDIN) and print "not "; |
91 | print "ok 16\n"; |
92 | |
93 | ($sel->exists(0) || $sel->exists([\*STDERR])) and print "not "; |
94 | print "ok 17\n"; |
95 | |
96 | $fd = $sel->exists(\*STDOUT); |
97 | if ($fd) { |
98 | print $fd "ok 18\n"; |
99 | } else { |
100 | print "not ok 18\n"; |
101 | } |
102 | |
103 | $fd = $sel->exists([1, 'foo']); |
104 | if ($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); |
112 | print "not " unless $sel->count == 7; |
113 | print "ok 20\n"; |
114 | |
115 | $sel->remove($sel->handles); |
116 | print "not " unless $sel->count == 0 && !defined($sel->bits); |
117 | print "ok 21\n"; |
d3a7d8c7 |
118 | |
119 | # check warnings |
120 | $SIG{__WARN__} = sub { |
121 | ++ $w |
87e7c081 |
122 | if $_[0] =~ /^Call to deprecated method 'has_error', use 'has_exception'/ |
d3a7d8c7 |
123 | } ; |
124 | $w = 0 ; |
125 | IO::Select::has_error(); |
126 | print "not " unless $w == 0 ; |
127 | $w = 0 ; |
128 | print "ok 22\n" ; |
129 | use warnings 'IO::Select' ; |
130 | IO::Select::has_error(); |
131 | print "not " unless $w == 1 ; |
132 | $w = 0 ; |
133 | print "ok 23\n" ; |