socketpair.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#!./perl -w
my $child;
my $can_fork;
my $has_perlio;
BEGIN {
chdir 't' if -d 't';
&& $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS\b/);
print "1..0\n";
exit 0;
}
# Too many things in this test will hang forever if something is wrong,
# so we need a self destruct timer. And IO can hang despite an alarm.
# This is convoluted, but we must fork before Test::More, else child's
# Test::More thinks that it ran no tests, and prints a message to that
# effect
my $parent = $$;
my $must_finish_by = time + 60;
my $remaining;
}
exit 1;
}
}
print <<EOF;
# Since you don't have perlio you might get failures with UTF-8 locales.
EOF
}
}
use Socket;
use strict;
use warnings;
use Errno;
my $skip_reason;
} else {
# This should fail but not die if there is real socketpair
eval {socketpair LEFT, RIGHT, -1, -1, -1};
} else {
eval {AF_UNIX};
} else {
}
}
}
# But we'll install an alarm handler in case any of the races below fail.
"socketpair (LEFT, RIGHT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)")
or print "# \$\! = $!\n";
if ($has_perlio) {
}
foreach (@left) {
# is (syswrite (LEFT, $_), length $_, "write " . _qq ($_) . " to left");
}
foreach (@right) {
# is (syswrite (RIGHT, $_), length $_, "write " . _qq ($_) . " to right");
}
# stream socket, so our writes will become joined:
# This will hang forever if eof is buggy, and alarm doesn't interrupt system
# Calls. Hence the child process minder.
SKIP: {
local $TODO = "Known problems with unix sockets on $^O"
alarm 3;
$! = 0;
local $TODO = "Known problems with unix sockets on $^O"
alarm 60;
}
my $err = $!;
{
alarm 3;
# Split the system call from the is() - is() does IO so
# (say) a flush may do a seek which on a pipe may disturb errno
$err = $!;
alarm 60;
}
{
# This may need skipping on some OSes - restoring value saved above
# should help
$! = $err;
}
}
# And now datagrams
# I suspect we also need a self destruct time-bomb for these, as I don't see any
# guarantee that the stack won't drop a UDP packet, even if it is for localhost.
SKIP: {
"socketpair (LEFT, RIGHT, AF_UNIX, SOCK_DGRAM, PF_UNSPEC)")
}
# is (syswrite (LEFT, $_), length $_, "write " . _qq ($_) . " to left");
}
# is (syswrite (RIGHT, $_), length $_, "write " . _qq ($_) . " to right");
}
# stream socket, so our writes will become joined:
}
}
# eof uses buffering. eof is indicated by a sysread of zero.
# but for a datagram socket there's no way it can know nothing will ever be
# sent
SKIP: {
my $alarmed = 0;
print "# Approximate forever as 3 seconds. Wait 'forever'...\n";
alarm 3;
"read on right should be interrupted");
}
alarm 30;
#ok (eof RIGHT, "right is at EOF");
}
}
} # end of DGRAM SKIP
exit 0;