recv.t revision 1.1.1.2 
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