io_sock.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#!./perl -w
BEGIN {
chdir 't' if -d 't';
}
}
use Config;
BEGIN {
if (-d "lib" && -f "TEST") {
my $reason;
}
}
}
exit 0;
}
}
}
$| = 1;
print "1..26\n";
eval {
alarm 120;
};
# some systems seem to need as much as 10,
# so be generous with the timeout
Timeout => 15,
print "ok 1\n";
# Check if can fork with dynamic extensions (bug in CRT):
print "ok $_ # skipped: broken fork\n" for 2..5;
exit 0;
}
print "ok 2\n";
print "ok 5\n";
PeerAddr => 'localhost'
)
PeerAddr => '127.0.0.1'
)
exit;
} else {
die;
}
# Test various other ways to create INET sockets that should
# also work.
while (1) {
last SERVER_LOOP if /^quit/;
last if /^done/;
print;
}
}
# child, try various ways to connect
print "ok 6\n";
print "ok 8\n";
}
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
}
else {
print "# $@\n";
print "not ok 10\n";
}
# some machines seem to suffer from a race condition here
} else {
print "not ok 11\n";
}
exit;
} else {
die;
}
# Then test UDP sockets
my $buf;
print $buf;
#child
exit;
} else {
die;
}
print "ok 13\n";
# QNX4 library bug: Can set non-blocking on socket, but
# cannot return that status.
print "ok 14 # skipped on QNX4\n";
} else {
print "ok 14\n";
}
### TEST 15
### Set up some data to be transfered between the server and
### the client. We'll use own source code ...
#
local @data;
print "not ok 15 - $!\n";
} else {
print "ok 15\n";
}
### TEST 16
### Start the server
#
print "not ";
print "ok 16\n";
if( $server_pid) {
#
print "ok 17\n";
### TEST 18
### Get data from the server using a single stream
#
}
} else {
print "not ";
}
print "ok 18\n";
### TEST 21
### Get data from the server using a stream, which is
### interrupted by eof calls.
### On perl-5.7.0@7673 this failed in a SOCKS environment, because eof
### did an getc followed by an ungetc in order to check for the streams
### end. getc(3) got replaced by the SOCKS funktion, which ended up in
### a recv(2) call on the socket, while ungetc(3) put back a character
### to an IO buffer, which never again was read.
#
### TESTS 19,20,21,22
### Try to ping-pong some Unicode.
#
} else {
print "ok 19 - Skip: no perlio\n";
}
"ok 20\n" : "not ok 20\n";
print $ord == 0x100 ?
"ok 21\n" : "not ok 21\n";
"ok 22\n" : "not ok 22\n";
} else {
print "ok $_ - Skip: no perlio\n" for 20..22;
}
last;
}
}
} else {
print "not ";
}
print "ok 23\n";
### TEST 24
### Stop the server
#
} else {
print "not ";
}
print "ok 24\n";
### Child
#
# a race condition with our client, just die if we fail.
last SERVER_LOOP if /^quit/;
last if /^done/;
next;
}
next;
}
next;
}
last;
}
print;
}
}
exit 0;
} else {
### Fork failed
#
print "not ok 17\n";
die;
}
# test Blocking option in constructor
print "ok 25\n";
print "ok 26 # skipped on QNX4\n";
# QNX4 library bug: Can set non-blocking on socket, but
# cannot return that status.
} else {
print "ok 26\n";
}