Commit | Line | Data |
0b09a93a |
1 | #!/usr/bin/perl -w |
2 | use strict; |
3 | use Test::More tests => 8; |
4 | use Socket; |
5 | use 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 | |
14 | my ($sock1, $sock2); |
15 | socketpair($sock1, $sock2, AF_UNIX, SOCK_STREAM, PF_UNSPEC); |
16 | |
17 | my $buffer; |
18 | send($sock1, "xyz", 0); |
19 | my $ret = recv($sock2, $buffer, 2, 0); |
20 | |
21 | use autodie qw(recv); |
22 | |
23 | SKIP: { |
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 | |
40 | eval { |
41 | # STDIN isn't a socket, so this should fail. |
42 | recv(STDIN,$buffer,1,0); |
43 | }; |
44 | |
45 | ok($@,'recv dies on returning undef'); |
46 | isa_ok($@,'autodie::exception'); |
47 | |
48 | $buffer = "# Not an empty string\n"; |
49 | |
50 | # Terminate writing for $sock1 |
51 | shutdown($sock1, 1); |
52 | |
53 | eval { |
54 | use autodie qw(send); |
55 | # Writing to a socket terminated for writing should fail. |
56 | send($sock1,$buffer,0); |
57 | }; |
58 | |
59 | ok($@,'send dies on returning undef'); |
60 | isa_ok($@,'autodie::exception'); |