This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add sleep() to avoid race on NeXT (from M.E. O'Neill
[perl5.git] / t / lib / io_sock.t
CommitLineData
61f2b451
PP
1#!./perl
2
3BEGIN {
7a4c00b4
PP
4 unless(grep /blib/, @INC) {
5 chdir 't' if -d 't';
93430cb4 6 unshift @INC, '../lib' if -d '../lib';
7a4c00b4
PP
7 }
8}
9
10use Config;
11
12BEGIN {
774d564b 13 if (-d "lib" && -f "TEST") {
45c0de28
GS
14 my $reason;
15 if (! $Config{'d_fork'}) {
16 $reason = 'no fork';
17 }
18 elsif ($Config{'extensions'} !~ /\bSocket\b/) {
19 $reason = 'Socket extension unavailable';
20 }
21 elsif ($Config{'extensions'} !~ /\bIO\b/) {
22 $reason = 'IO extension unavailable';
23 }
24 undef $reason if $^O eq 'VMS' and $Config{d_socket};
25 if ($reason) {
26 print "1..0 # Skip: $reason\n";
7a4c00b4
PP
27 exit 0;
28 }
61f2b451
PP
29 }
30}
31
32$| = 1;
cf7fe8a2 33print "1..14\n";
61f2b451
PP
34
35use IO::Socket;
36
7a4c00b4
PP
37$listen = IO::Socket::INET->new(Listen => 2,
38 Proto => 'tcp',
862b0ad8
GS
39 # some systems seem to need as much as 10,
40 # so be generous with the timeout
41 Timeout => 15,
7a4c00b4 42 ) or die "$!";
61f2b451 43
7a4c00b4 44print "ok 1\n";
61f2b451 45
a245ea2d
IZ
46# Check if can fork with dynamic extensions (bug in CRT):
47if ($^O eq 'os2' and
48 system "$^X -I../lib -MOpcode -e 'defined fork or die' > /dev/null 2>&1") {
49 print "ok $_ # skipped: broken fork\n" for 2..5;
50 exit 0;
51}
52
7a4c00b4 53$port = $listen->sockport;
61f2b451 54
7a4c00b4 55if($pid = fork()) {
61f2b451 56
e197ebb9 57 $sock = $listen->accept() or die "accept failed: $!";
61f2b451
PP
58 print "ok 2\n";
59
60 $sock->autoflush(1);
61 print $sock->getline();
62
63 print $sock "ok 4\n";
64
65 $sock->close;
66
67 waitpid($pid,0);
68
69 print "ok 5\n";
61f2b451 70
7a4c00b4 71} elsif(defined $pid) {
61f2b451 72
68820cec
DM
73 # This can fail if localhost is undefined or the
74 # special 'loopback' address 127.0.0.1 is not configured
75 # on your system. (/etc/rc.config.d/netconfig on HP-UX.)
9b599b2a
GS
76 # As a shortcut (not recommended) you could change 'localhost'
77 # here to be the name of this machine eg 'myhost.mycompany.com'.
68820cec 78
61f2b451
PP
79 $sock = IO::Socket::INET->new(PeerPort => $port,
80 Proto => 'tcp',
81 PeerAddr => 'localhost'
9b599b2a 82 )
cf7fe8a2 83 or die "$! (maybe your system does not have the 'localhost' address defined)";
61f2b451
PP
84
85 $sock->autoflush(1);
7a4c00b4 86
61f2b451 87 print $sock "ok 3\n";
7a4c00b4 88
61f2b451 89 print $sock->getline();
7a4c00b4 90
61f2b451 91 $sock->close;
7a4c00b4 92
61f2b451
PP
93 exit;
94} else {
95 die;
96}
97
cf7fe8a2
GS
98# Test various other ways to create INET sockets that should
99# also work.
862b0ad8 100$listen = IO::Socket::INET->new(Listen => '', Timeout => 15) or die "$!";
cf7fe8a2 101$port = $listen->sockport;
61f2b451 102
cf7fe8a2
GS
103if($pid = fork()) {
104 SERVER_LOOP:
105 while (1) {
106 last SERVER_LOOP unless $sock = $listen->accept;
107 while (<$sock>) {
108 last SERVER_LOOP if /^quit/;
109 last if /^done/;
110 print;
111 }
112 $sock = undef;
113 }
114 $listen->close;
115} elsif (defined $pid) {
116 # child, try various ways to connect
117 $sock = IO::Socket::INET->new("localhost:$port");
118 if ($sock) {
119 print "not " unless $sock->connected;
120 print "ok 6\n";
121 $sock->print("ok 7\n");
122 sleep(1);
123 print "ok 8\n";
124 $sock->print("ok 9\n");
125 $sock->print("done\n");
126 $sock->close;
127 }
128 else {
129 print "# $@\n";
130 print "not ok 6\n";
131 print "not ok 7\n";
132 print "not ok 8\n";
133 print "not ok 9\n";
134 }
135
136 # some machines seem to suffer from a race condition here
d6a255e6 137 sleep(2);
cf7fe8a2
GS
138
139 $sock = IO::Socket::INET->new("127.0.0.1:$port");
140 if ($sock) {
141 $sock->print("ok 10\n");
142 $sock->print("done\n");
143 $sock->close;
144 }
145 else {
146 print "# $@\n";
147 print "not ok 10\n";
148 }
61f2b451 149
cf7fe8a2 150 # some machines seem to suffer from a race condition here
e3e876cf 151 sleep(1);
61f2b451 152
cf7fe8a2
GS
153 $sock = IO::Socket->new(Domain => AF_INET,
154 PeerAddr => "localhost:$port");
155 if ($sock) {
156 $sock->print("ok 11\n");
157 $sock->print("quit\n");
158 }
159 $sock = undef;
160 sleep(1);
161 exit;
162} else {
163 die;
164}
165
166# Then test UDP sockets
167$server = IO::Socket->new(Domain => AF_INET,
168 Proto => 'udp',
169 LocalAddr => 'localhost');
170$port = $server->sockport;
171
0994c4d0
JH
172if ($^O eq 'mpeix') {
173 print("ok 12 # skipped\n")
cf7fe8a2 174} else {
0994c4d0
JH
175 if ($pid = fork()) {
176 my $buf;
177 $server->recv($buf, 100);
178 print $buf;
179 } elsif (defined($pid)) {
180 #child
181 $sock = IO::Socket::INET->new(Proto => 'udp',
182 PeerAddr => "localhost:$port");
183 $sock->send("ok 12\n");
184 sleep(1);
185 $sock->send("ok 12\n"); # send another one to be sure
186 exit;
187 } else {
188 die;
189 }
cf7fe8a2 190}
61f2b451 191
cf7fe8a2
GS
192print "not " unless $server->blocking;
193print "ok 13\n";
61f2b451 194
cf7fe8a2
GS
195$server->blocking(0);
196print "not " if $server->blocking;
197print "ok 14\n";