t/lib/io_sock.t

   1 #!./perl
   2
   3 BEGIN {
   4     unless(grep /blib/, @INC) {
   5         chdir 't' if -d 't';
   6         @INC = '../lib' if -d '../lib';
   7     }
   8 }
   9
  10 use Config;
  11
  12 BEGIN {
  13     if (-d "lib" && -f "TEST") {
  14         if (!$Config{'d_fork'} ||
  15             (($Config{'extensions'} !~ /\bSocket\b/ ||
  16               $Config{'extensions'} !~ /\bIO\b/) &&
  17              !(($^O eq 'VMS') && $Config{d_socket}))) {
  18             print "1..0\n";
  19             exit 0;
  20         }
  21     }
  22 }
  23
  24 $| = 1;
  25 print "1..5\n";
  26
  27 use IO::Socket;
  28
  29 $listen = IO::Socket::INET->new(Listen => 2,
  30                                 Proto => 'tcp',
  31                                ) or die "$!";
  32
  33 print "ok 1\n";
  34
  35 # Check if can fork with dynamic extensions (bug in CRT):
  36 if ($^O eq 'os2' and
  37     system "$^X -I../lib -MOpcode -e 'defined fork or die'  > /dev/null 2>&1") {
  38     print "ok $_ # skipped: broken fork\n" for 2..5;
  39     exit 0;
  40 }
  41
  42 $port = $listen->sockport;
  43
  44 if($pid = fork()) {
  45
  46     $sock = $listen->accept();
  47     print "ok 2\n";
  48
  49     $sock->autoflush(1);
  50     print $sock->getline();
  51
  52     print $sock "ok 4\n";
  53
  54     $sock->close;
  55
  56     waitpid($pid,0);
  57
  58     print "ok 5\n";
  59
  60 } elsif(defined $pid) {
  61
  62     # This can fail if localhost is undefined or the
  63     # special 'loopback' address 127.0.0.1 is not configured
  64     # on your system. (/etc/rc.config.d/netconfig on HP-UX.)
  65     # As a shortcut (not recommended) you could change 'localhost'
  66     # here to be the name of this machine eg 'myhost.mycompany.com'.
  67
  68     $sock = IO::Socket::INET->new(PeerPort => $port,
  69                                   Proto => 'tcp',
  70                                   PeerAddr => 'localhost'
  71                                  )
  72             or die "$! (maybe your system does not have the 'localhost' address defined)";
  73
  74     $sock->autoflush(1);
  75
  76     print $sock "ok 3\n";
  77
  78     print $sock->getline();
  79
  80     $sock->close;
  81
  82     exit;
  83 } else {
  84  die;
  85 }
  86
  87
  88
  89
  90
  91