home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / lib / io_sel.t < prev    next >
Text File  |  2000-03-12  |  3KB  |  133 lines
  1. #!./perl
  2.  
  3. BEGIN {
  4.     unless(grep /blib/, @INC) {
  5.         chdir 't' if -d 't';
  6.         unshift @INC, '../lib' if -d '../lib';
  7.     }
  8. }
  9.  
  10. select(STDERR); $| = 1;
  11. select(STDOUT); $| = 1;
  12.  
  13. print "1..23\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.  
  52. if ($^O eq 'MSWin32' || $^O eq 'dos') {  # 4-arg select is only valid on sockets
  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.  
  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.  
  87. POST_SOCKET:
  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";
  117.  
  118. # check warnings
  119. $SIG{__WARN__} = sub { 
  120.     ++ $w 
  121.       if $_[0] =~ /^Call to depreciated method 'has_error', use 'has_exception'/ 
  122.     } ;
  123. $w = 0 ;
  124. IO::Select::has_error();
  125. print "not " unless $w == 0 ;
  126. $w = 0 ;
  127. print "ok 22\n" ;
  128. use warnings 'IO::Select' ;
  129. IO::Select::has_error();
  130. print "not " unless $w == 1 ;
  131. $w = 0 ;
  132. print "ok 23\n" ;
  133.