diff options
Diffstat (limited to 'contrib/perl5/t/lib/io_sock.t')
| -rwxr-xr-x | contrib/perl5/t/lib/io_sock.t | 124 |
1 files changed, 115 insertions, 9 deletions
diff --git a/contrib/perl5/t/lib/io_sock.t b/contrib/perl5/t/lib/io_sock.t index 8fc52e4..056d131f 100755 --- a/contrib/perl5/t/lib/io_sock.t +++ b/contrib/perl5/t/lib/io_sock.t @@ -3,7 +3,7 @@ BEGIN { unless(grep /blib/, @INC) { chdir 't' if -d 't'; - @INC = '../lib' if -d '../lib'; + unshift @INC, '../lib' if -d '../lib'; } } @@ -11,23 +11,34 @@ use Config; BEGIN { if (-d "lib" && -f "TEST") { - if (!$Config{'d_fork'} || - (($Config{'extensions'} !~ /\bSocket\b/ || - $Config{'extensions'} !~ /\bIO\b/) && - !(($^O eq 'VMS') && $Config{d_socket}))) { - print "1..0\n"; + my $reason; + if (! $Config{'d_fork'}) { + $reason = 'no fork'; + } + elsif ($Config{'extensions'} !~ /\bSocket\b/) { + $reason = 'Socket extension unavailable'; + } + elsif ($Config{'extensions'} !~ /\bIO\b/) { + $reason = 'IO extension unavailable'; + } + undef $reason if $^O eq 'VMS' and $Config{d_socket}; + if ($reason) { + print "1..0 # Skip: $reason\n"; exit 0; } } } $| = 1; -print "1..5\n"; +print "1..14\n"; use IO::Socket; $listen = IO::Socket::INET->new(Listen => 2, Proto => 'tcp', + # some systems seem to need as much as 10, + # so be generous with the timeout + Timeout => 15, ) or die "$!"; print "ok 1\n"; @@ -43,7 +54,7 @@ $port = $listen->sockport; if($pid = fork()) { - $sock = $listen->accept(); + $sock = $listen->accept() or die "accept failed: $!"; print "ok 2\n"; $sock->autoflush(1); @@ -69,7 +80,7 @@ if($pid = fork()) { Proto => 'tcp', PeerAddr => 'localhost' ) - or die "$! (maybe your system does not have the 'localhost' address defined)"; + or die "$! (maybe your system does not have the 'localhost' address defined)"; $sock->autoflush(1); @@ -84,8 +95,103 @@ if($pid = fork()) { die; } +# Test various other ways to create INET sockets that should +# also work. +$listen = IO::Socket::INET->new(Listen => '', Timeout => 15) or die "$!"; +$port = $listen->sockport; + +if($pid = fork()) { + SERVER_LOOP: + while (1) { + last SERVER_LOOP unless $sock = $listen->accept; + while (<$sock>) { + last SERVER_LOOP if /^quit/; + last if /^done/; + print; + } + $sock = undef; + } + $listen->close; +} elsif (defined $pid) { + # child, try various ways to connect + $sock = IO::Socket::INET->new("localhost:$port"); + if ($sock) { + print "not " unless $sock->connected; + print "ok 6\n"; + $sock->print("ok 7\n"); + sleep(1); + print "ok 8\n"; + $sock->print("ok 9\n"); + $sock->print("done\n"); + $sock->close; + } + else { + print "# $@\n"; + print "not ok 6\n"; + print "not ok 7\n"; + print "not ok 8\n"; + print "not ok 9\n"; + } + + # some machines seem to suffer from a race condition here + sleep(2); + + $sock = IO::Socket::INET->new("127.0.0.1:$port"); + if ($sock) { + $sock->print("ok 10\n"); + $sock->print("done\n"); + $sock->close; + } + else { + print "# $@\n"; + print "not ok 10\n"; + } + # some machines seem to suffer from a race condition here + sleep(1); + $sock = IO::Socket->new(Domain => AF_INET, + PeerAddr => "localhost:$port"); + if ($sock) { + $sock->print("ok 11\n"); + $sock->print("quit\n"); + } + $sock = undef; + sleep(1); + exit; +} else { + die; +} +# Then test UDP sockets +$server = IO::Socket->new(Domain => AF_INET, + Proto => 'udp', + LocalAddr => 'localhost'); +$port = $server->sockport; + +if ($^O eq 'mpeix') { + print("ok 12 # skipped\n") +} else { + if ($pid = fork()) { + my $buf; + $server->recv($buf, 100); + print $buf; + } elsif (defined($pid)) { + #child + $sock = IO::Socket::INET->new(Proto => 'udp', + PeerAddr => "localhost:$port"); + $sock->send("ok 12\n"); + sleep(1); + $sock->send("ok 12\n"); # send another one to be sure + exit; + } else { + die; + } +} +print "not " unless $server->blocking; +print "ok 13\n"; +$server->blocking(0); +print "not " if $server->blocking; +print "ok 14\n"; |
