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 srand(time);
  21 $port = 4002 + int(rand 0xff);
  22 print "# using port $port.\n";
  23 $SIG{ALRM} = sub {};
  24
  25 $pid =  fork();
  26
  27 if($pid) {
  28
  29     $listen = IO::Socket::INET->new(Listen => 2,
  30                                     Proto => 'tcp',
  31                                     LocalPort => $port
  32                                    ) or die "$!";
  33
  34     print "ok 1\n";
  35
  36     # Wake out child
  37     kill(ALRM => $pid);
  38
  39     $sock = $listen->accept();
  40     print "ok 2\n";
  41
  42     $sock->autoflush(1);
  43     print $sock->getline();
  44
  45     print $sock "ok 4\n";
  46
  47     $sock->close;
  48
  49     waitpid($pid,0);
  50
  51     print "ok 5\n";
  52 } elsif(defined $pid) {
  53
  54     # Wait for a small pause, so that we can ensure the listen socket is setup
  55     # the parent will awake us with a SIGALRM
  56
  57     sleep(10);
  58
  59     $sock = IO::Socket::INET->new(PeerPort => $port,
  60                                   Proto => 'tcp',
  61                                   PeerAddr => 'localhost'
  62                                  ) or die "$!";
  63
  64     $sock->autoflush(1);
  65     print $sock "ok 3\n";
  66     print $sock->getline();
  67     $sock->close;
  68     exit;
  69 } else {
  70  die;
  71 }
  72
  73
  74
  75
  76
  77