t/lib/io_udp.t

   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         if ( ($Config{'extensions'} !~ /\bSocket\b/ ||
  15               $Config{'extensions'} !~ /\bIO\b/ ||
  16               $^O eq 'os2')    &&
  17               !(($^O eq 'VMS') && $Config{d_socket})) {
  18             print "1..0\n";
  19             exit 0;
  20         }
  21     }
  22 }
  23
  24 sub compare_addr {
  25     my $a = shift;
  26     my $b = shift;
  27     my @a = unpack_sockaddr_in($a);
  28     my @b = unpack_sockaddr_in($b);
  29     "$a[0]$a[1]" eq "$b[0]$b[1]";
  30 }
  31
  32 $| = 1;
  33 print "1..7\n";
  34
  35 use Socket;
  36 use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY);
  37
  38     # This can fail if localhost is undefined or the
  39     # special 'loopback' address 127.0.0.1 is not configured
  40     # on your system. (/etc/rc.config.d/netconfig on HP-UX.)
  41     # As a shortcut (not recommended) you could change 'localhost'
  42     # here to be the name of this machine eg 'myhost.mycompany.com'.
  43
  44 $udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
  45     or die "$! (maybe your system does not have the 'localhost' address defined)";
  46
  47 print "ok 1\n";
  48
  49 $udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
  50     or die "$! (maybe your system does not have the 'localhost' address defined)";
  51
  52 print "ok 2\n";
  53
  54 $udpa->send("ok 4\n",0,$udpb->sockname);
  55
  56 print "not " unless compare_addr($udpa->peername,$udpb->sockname);
  57 print "ok 3\n";
  58
  59 my $where = $udpb->recv($buf="",5);
  60 print $buf;
  61
  62 my @xtra = ();
  63
  64 unless(compare_addr($where,$udpa->sockname)) {
  65     print "not ";
  66     @xtra = (0,$udpa->sockname);
  67 }
  68 print "ok 5\n";
  69
  70 $udpb->send("ok 6\n",@xtra);
  71 $udpa->recv($buf="",5);
  72 print $buf;
  73
  74 print "not " if $udpa->connected;
  75 print "ok 7\n";