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); 16binmode $sock1; 17binmode $sock2; 18 19my $buffer; 20send($sock1, "xyz", 0); 21my $ret = recv($sock2, $buffer, 2, 0); 22 23use autodie qw(recv); 24 25SKIP: { 26 27 skip('recv() never returns empty string with socketpair emulation',4) 28 if ($ret); 29 30 is($buffer,'xy',"recv() operational without autodie"); 31 32 # Read the last byte from the socket. 33 eval { $ret = recv($sock2, $buffer, 1, 0); }; 34 35 is($@, "", "recv should not die on returning an emtpy string."); 36 37 is($buffer,"z","recv() operational with autodie"); 38 is($ret,"","recv returns undying empty string for local sockets"); 39 40} 41 42eval { 43 my $string = "now is the time..."; 44 open(my $fh, '<', \$string) or die("Can't open \$string for read"); 45 binmode $fh; 46 # $fh isn't a socket, so this should fail. 47 recv($fh,$buffer,1,0); 48}; 49 50ok($@,'recv dies on returning undef'); 51isa_ok($@,'autodie::exception') 52 or diag("$@"); 53 54$buffer = "# Not an empty string\n"; 55 56# Terminate writing for $sock1 57shutdown($sock1, 1); 58 59eval { 60 use autodie qw(send); 61 # Writing to a socket terminated for writing should fail. 62 send($sock1,$buffer,0); 63}; 64 65ok($@,'send dies on returning undef'); 66isa_ok($@,'autodie::exception'); 67