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