home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / lib / socket.t < prev    next >
Text File  |  2000-03-12  |  2KB  |  88 lines
  1. #!./perl
  2.  
  3. BEGIN {
  4.     chdir 't' if -d 't';
  5.     unshift @INC, '../lib' if -d '../lib';
  6.     require Config; import Config;
  7.     if ($Config{'extensions'} !~ /\bSocket\b/ && 
  8.         !(($^O eq 'VMS') && $Config{d_socket})) {
  9.     print "1..0\n";
  10.     exit 0;
  11.     }
  12. }
  13.     
  14. use Socket;
  15.  
  16. print "1..8\n";
  17.  
  18. if (socket(T,PF_INET,SOCK_STREAM,6)) {
  19.   print "ok 1\n";
  20.  
  21.   if (connect(T,pack_sockaddr_in(7,inet_aton("localhost")))){
  22.     print "ok 2\n";
  23.  
  24.     print "# Connected to ",
  25.         inet_ntoa((unpack_sockaddr_in(getpeername(T)))[1]),"\n";
  26.  
  27.     syswrite(T,"hello",5);
  28.     $read = sysread(T,$buff,10);    # Connection may be granted, then closed!
  29.     while ($read > 0 && length($buff) < 5) {
  30.         # adjust for fact that TCP doesn't guarantee size of reads/writes
  31.         $read = sysread(T,$buff,10,length($buff));
  32.     }
  33.     print(($read == 0 || $buff eq "hello") ? "ok 3\n" : "not ok 3\n");
  34.   }
  35.   else {
  36.     print "# You're allowed to fail tests 2 and 3 if.\n";
  37.     print "# The echo service has been disabled.\n";
  38.     print "# $!\n";
  39.     print "ok 2\n";
  40.     print "ok 3\n";
  41.   }
  42. }
  43. else {
  44.     print "# $!\n";
  45.     print "not ok 1\n";
  46. }
  47.  
  48. if( socket(S,PF_INET,SOCK_STREAM,6) ){
  49.   print "ok 4\n";
  50.  
  51.   if (connect(S,pack_sockaddr_in(7,INADDR_LOOPBACK))){
  52.     print "ok 5\n";
  53.  
  54.     print "# Connected to ",
  55.         inet_ntoa((unpack_sockaddr_in(getpeername(S)))[1]),"\n";
  56.  
  57.     syswrite(S,"olleh",5);
  58.     $read = sysread(S,$buff,10);    # Connection may be granted, then closed!
  59.     while ($read > 0 && length($buff) < 5) {
  60.         # adjust for fact that TCP doesn't guarantee size of reads/writes
  61.         $read = sysread(S,$buff,10,length($buff));
  62.     }
  63.     print(($read == 0 || $buff eq "olleh") ? "ok 6\n" : "not ok 6\n");
  64.   }
  65.   else {
  66.     print "# You're allowed to fail tests 5 and 6 if.\n";
  67.     print "# The echo service has been disabled.\n";
  68.     print "# $!\n";
  69.     print "ok 5\n";
  70.     print "ok 6\n";
  71.   }
  72. }
  73. else {
  74.     print "# $!\n";
  75.     print "not ok 4\n";
  76. }
  77.  
  78. # warnings
  79. $SIG{__WARN__} = sub {
  80.     ++ $w if $_[0] =~ /^6-ARG sockaddr_in call is deprecated/ ;
  81. } ;
  82. $w = 0 ;
  83. sockaddr_in(1,2,3,4,5,6) ;
  84. print ($w == 1 ? "not ok 7\n" : "ok 7\n") ;
  85. use warnings 'Socket' ;
  86. sockaddr_in(1,2,3,4,5,6) ;
  87. print ($w == 1 ? "ok 8\n" : "not ok 8\n") ;
  88.