1#!/usr/bin/perl 2 3use warnings; 4use strict; 5 6use IO::Socket; 7use IO::Socket::INET; 8use Socket; 9use Test::More; 10use Config; 11 12plan tests => 9; 13 14my $listener = IO::Socket::INET->new(Listen => 1, 15 LocalAddr => '127.0.0.1', 16 Proto => 'tcp'); 17ok(defined($listener), 'socket created'); 18 19my $port = $listener->sockport(); 20 21my $p = $listener->protocol(); 22ok(defined($p), 'protocol defined'); 23my $d = $listener->sockdomain(); 24ok(defined($d), 'domain defined'); 25my $s = $listener->socktype(); 26ok(defined($s), 'type defined'); 27 28SKIP: { 29 skip "fork not available", 5 30 unless $Config{d_fork} || $Config{d_pseudofork}; 31 32 my $cpid = fork(); 33 if (0 == $cpid) { 34 # the child: 35 sleep(1); 36 my $connector = IO::Socket::INET->new(PeerAddr => '127.0.0.1', 37 PeerPort => $port, 38 Proto => 'tcp'); 39 if ($connector) { 40 my $buf; 41 # wait for parent to close its end 42 $connector->read($buf, 1); 43 } 44 else { 45 diag "child failed to connect to parent: $@"; 46 } 47 exit(0); 48 } else {; 49 ok(defined($cpid), 'spawned a child'); 50 } 51 52 my $new = $listener->accept(); 53 54 ok($new, "got a socket from accept") 55 or diag "accept failed: $@"; 56 57 is($new->sockdomain(), $d, 'domain match'); 58 SKIP: { 59 skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL }); 60 is($new->protocol(), $p, 'protocol match'); 61 } 62 SKIP: { 63 skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE }); 64 is($new->socktype(), $s, 'type match'); 65 } 66 $new->close; 67 68 wait(); 69} 70