This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add tests for new IO extension
[perl5.git] / 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