| 1 | #!./perl |
| 2 | |
| 3 | BEGIN { |
| 4 | chdir 't' if -d 't'; |
| 5 | require Config; import Config; |
| 6 | require './test.pl'; |
| 7 | set_up_inc('../lib'); |
| 8 | skip_all_if_miniperl(); |
| 9 | for my $needed (qw(d_socket)) { |
| 10 | if ($Config{$needed} ne 'define') { |
| 11 | skip_all("-- \$Config{$needed} undefined"); |
| 12 | } |
| 13 | } |
| 14 | unless ($Config{extensions} =~ /\bSocket\b/) { |
| 15 | skip_all('-- Socket not available'); |
| 16 | } |
| 17 | } |
| 18 | |
| 19 | use strict; |
| 20 | use IO::Handle; |
| 21 | use Socket; |
| 22 | |
| 23 | { |
| 24 | socketpair(my $a, my $b, PF_UNIX, SOCK_STREAM, 0) |
| 25 | or skip_all("socketpair() for PF_UNIX failed ($!)"); |
| 26 | } |
| 27 | |
| 28 | plan(tests => 8); |
| 29 | |
| 30 | { |
| 31 | my($a, $b); |
| 32 | ok socketpair($a, $b, PF_UNIX, SOCK_STREAM, 0), "create socket pair"; |
| 33 | ok($a->printflush("aa\n"), "write one way"); |
| 34 | ok($b->printflush("bb\n"), "write other way"); |
| 35 | is(readline($b), "aa\n", "read one way"); |
| 36 | is(readline($a), "bb\n", "read other way"); |
| 37 | ok(close $a, "close one end"); |
| 38 | ok(close $b, "close other end"); |
| 39 | } |
| 40 | |
| 41 | SKIP: { |
| 42 | skip "no fcntl", 1 unless $Config{d_fcntl}; |
| 43 | my($a, $b); |
| 44 | socketpair($a, $b, PF_UNIX, SOCK_STREAM, 0) or die "socketpair: $!"; |
| 45 | my $fda = fileno($a); |
| 46 | my $fdb = fileno($b); |
| 47 | fresh_perl_is(qq( |
| 48 | print open(F, "+<&=$fda") ? 1 : 0, "\\n"; |
| 49 | print open(F, "+<&=$fdb") ? 1 : 0, "\\n"; |
| 50 | ), "0\n0\n", {}, "sockets not inherited across exec"); |
| 51 | } |