home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / lib / io_udp.t < prev    next >
Text File  |  1999-07-24  |  2KB  |  99 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. use Config;
  11.  
  12. BEGIN {
  13.     if(-d "lib" && -f "TEST") {
  14.     my $reason;
  15.  
  16.     if ($Config{'extensions'} !~ /\bSocket\b/) {
  17.       $reason = 'Socket was not built';
  18.     }
  19.     elsif ($Config{'extensions'} !~ /\bIO\b/) {
  20.       $reason = 'IO was not built';
  21.     }
  22.     elsif ($^O eq 'apollo') {
  23.       $reason = "unknown *FIXME*";
  24.     }
  25.     undef $reason if $^O eq 'VMS' and $Config{d_socket};
  26.     if ($reason) {
  27.         print "1..0 # Skip: $reason\n";
  28.         exit 0;
  29.     }
  30.     }
  31. }
  32.  
  33. sub compare_addr {
  34.     no utf8;
  35.     my $a = shift;
  36.     my $b = shift;
  37.     if (length($a) != length $b) {
  38.     my $min = (length($a) < length $b) ? length($a) : length $b;
  39.     if ($min and substr($a, 0, $min) eq substr($b, 0, $min)) {
  40.         printf "# Apparently: %d bytes junk at the end of %s\n# %s\n",
  41.         abs(length($a) - length ($b)),
  42.         $_[length($a) < length ($b) ? 1 : 0],
  43.         "consider decreasing bufsize of recfrom.";
  44.         substr($a, $min) = "";
  45.         substr($b, $min) = "";
  46.     }
  47.     return 0;
  48.     }
  49.     my @a = unpack_sockaddr_in($a);
  50.     my @b = unpack_sockaddr_in($b);
  51.     "$a[0]$a[1]" eq "$b[0]$b[1]";
  52. }
  53.  
  54. $| = 1;
  55. print "1..7\n";
  56.  
  57. use Socket;
  58. use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY);
  59.  
  60.     # This can fail if localhost is undefined or the
  61.     # special 'loopback' address 127.0.0.1 is not configured
  62.     # on your system. (/etc/rc.config.d/netconfig on HP-UX.)
  63.     # As a shortcut (not recommended) you could change 'localhost'
  64.     # here to be the name of this machine eg 'myhost.mycompany.com'.
  65.  
  66. $udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
  67.     or die "$! (maybe your system does not have the 'localhost' address defined)";
  68.  
  69. print "ok 1\n";
  70.  
  71. $udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
  72.     or die "$! (maybe your system does not have the 'localhost' address defined)";
  73.  
  74. print "ok 2\n";
  75.  
  76. $udpa->send("ok 4\n",0,$udpb->sockname);
  77.  
  78. print "not "
  79.   unless compare_addr($udpa->peername,$udpb->sockname, 'peername', 'sockname');
  80. print "ok 3\n";
  81.  
  82. my $where = $udpb->recv($buf="",5);
  83. print $buf;
  84.  
  85. my @xtra = ();
  86.  
  87. unless(compare_addr($where,$udpa->sockname, 'recv name', 'sockname')) {
  88.     print "not ";
  89.     @xtra = (0,$udpa->sockname);
  90. }
  91. print "ok 5\n";
  92.  
  93. $udpb->send("ok 6\n",@xtra);
  94. $udpa->recv($buf="",5);
  95. print $buf;
  96.  
  97. print "not " if $udpa->connected;
  98. print "ok 7\n";
  99.