1#!/usr/bin/perl -w 2use strict; 3use Test::More tests => 8; 4use Socket; 5use autodie qw(socketpair); 6 7# All of this code is based around recv returning an empty 8# string when it gets data from a local machine (using AF_UNIX), 9# but returning an undefined value on error. Fatal/autodie 10# should be able to tell the difference. 11 12$SIG{PIPE} = 'IGNORE'; 13 14my ($sock1, $sock2); 15socketpair($sock1, $sock2, AF_UNIX, SOCK_STREAM, PF_UNSPEC); 16 17my $buffer; 18send($sock1, "xyz", 0); 19my $ret = recv($sock2, $buffer, 2, 0); 20 21use autodie qw(recv); 22 23SKIP: { 24 25 skip('recv() never returns empty string with socketpair emulation',4) 26 if ($ret); 27 28 is($buffer,'xy',"recv() operational without autodie"); 29 30 # Read the last byte from the socket. 31 eval { $ret = recv($sock2, $buffer, 1, 0); }; 32 33 is($@, "", "recv should not die on returning an emtpy string."); 34 35 is($buffer,"z","recv() operational with autodie"); 36 is($ret,"","recv returns undying empty string for local sockets"); 37 38} 39 40eval { 41 my $string = "now is the time..."; 42 open(my $fh, '<', \$string) or die("Can't open \$string for read"); 43 # $fh isn't a socket, so this should fail. 44 recv($fh,$buffer,1,0); 45}; 46 47ok($@,'recv dies on returning undef'); 48isa_ok($@,'autodie::exception') 49 or diag("$@"); 50 51$buffer = "# Not an empty string\n"; 52 53# Terminate writing for $sock1 54shutdown($sock1, 1); 55 56eval { 57 use autodie qw(send); 58 # Writing to a socket terminated for writing should fail. 59 send($sock1,$buffer,0); 60}; 61 62ok($@,'send dies on returning undef'); 63isa_ok($@,'autodie::exception'); 64