t/lib/io_sock.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib' if -d '../lib';
   6     require Config; import Config;
   7     if ( ($Config{'extensions'} !~ /\bSocket\b/ ||
   8           $Config{'extensions'} !~ /\bIO\b/)    &&
   9           !(($^O eq 'VMS') && $Config{d_socket})) {
  10         print "1..0\n";
  11         exit 0;
  12     }
  13 }
  14
  15 $| = 1;
  16 print "1..5\n";
  17
  18 use IO::Socket;
  19
  20 $port = 4002 + int(rand(time) & 0xff);
  21 $SIG{ALRM} = sub {};
  22
  23 $pid =  fork();
  24
  25 if($pid) {
  26
  27     $listen = IO::Socket::INET->new(Listen => 2,
  28                                     Proto => 'tcp',
  29                                     LocalPort => $port
  30                                    ) or die "$!";
  31
  32     print "ok 1\n";
  33
  34     # Wake out child
  35     kill(ALRM => $pid);
  36
  37     $sock = $listen->accept();
  38     print "ok 2\n";
  39
  40     $sock->autoflush(1);
  41     print $sock->getline();
  42
  43     print $sock "ok 4\n";
  44
  45     $sock->close;
  46
  47     waitpid($pid,0);
  48
  49     print "ok 5\n";
  50 } elsif(defined $pid) {
  51
  52     # Wait for a small pause, so that we can ensure the listen socket is setup
  53     # the parent will awake us with a SIGALRM
  54
  55     sleep(10);
  56
  57     $sock = IO::Socket::INET->new(PeerPort => $port,
  58                                   Proto => 'tcp',
  59                                   PeerAddr => 'localhost'
  60                                  ) or die "$!";
  61
  62     $sock->autoflush(1);
  63     print $sock "ok 3\n";
  64     print $sock->getline();
  65     $sock->close;
  66     exit;
  67 } else {
  68  die;
  69 }
  70
  71
  72
  73
  74
  75