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
  22 $pid =  fork();
  23
  24 if($pid) {
  25
  26     $listen = IO::Socket::INET->new(Listen => 2,
  27                                     Proto => 'tcp',
  28                                     LocalPort => $port
  29                                    ) or die "$!";
  30
  31     print "ok 1\n";
  32
  33     # Wake out child
  34     kill(ALRM => $pid);
  35
  36     $sock = $listen->accept();
  37     print "ok 2\n";
  38
  39     $sock->autoflush(1);
  40     print $sock->getline();
  41
  42     print $sock "ok 4\n";
  43
  44     $sock->close;
  45
  46     waitpid($pid,0);
  47
  48     print "ok 5\n";
  49 } elsif(defined $pid) {
  50
  51     # Wait for a small pause, so that we can ensure the listen socket is setup
  52     # the parent will awake us with a SIGALRM
  53
  54     $SIG{ALRM} = sub {};
  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