This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[rt.cpan.org #61577] try to populate socket info when not cached
[perl5.git] / dist / IO / t / cachepropagate-unix.t
CommitLineData
93a5d7bf
TC
1#!/usr/bin/perl
2
3use warnings;
4use strict;
5
6use File::Temp qw(tempdir);
7use File::Spec::Functions;
8use IO::Socket;
9use IO::Socket::UNIX;
10use Socket;
11use Config;
12use Test::More;
13
14plan skip_all => "UNIX domain sockets not implemented on $^O"
15 if ($^O =~ m/^(?:qnx|nto|vos|MSWin32)$/);
16
17plan tests => 15;
18
19my $socketpath = catfile(tempdir( CLEANUP => 1 ), 'testsock');
20
21# start testing stream sockets:
22my $listener = IO::Socket::UNIX->new(Type => SOCK_STREAM,
23 Listen => 1,
24 Local => $socketpath);
25ok(defined($listener), 'stream socket created');
26
27my $p = $listener->protocol();
28ok(defined($p), 'protocol defined');
29my $d = $listener->sockdomain();
30ok(defined($d), 'domain defined');
31my $s = $listener->socktype();
32ok(defined($s), 'type defined');
33
34SKIP: {
35 skip "fork not available", 4
36 unless $Config{d_fork} || $Config{d_pseudofork};
37
38 my $cpid = fork();
39 if (0 == $cpid) {
40 # the child:
41 sleep(1);
42 my $connector = IO::Socket::UNIX->new(Peer => $socketpath);
43 exit(0);
44 } else {
45 ok(defined($cpid), 'spawned a child');
46 }
47
48 my $new = $listener->accept();
49
93a5d7bf
TC
50 is($new->sockdomain(), $d, 'domain match');
51 SKIP: {
52 skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });
53 is($new->protocol(), $p, 'protocol match');
54 }
55 SKIP: {
56 skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE });
57 is($new->socktype(), $s, 'type match');
58 }
59
60 unlink($socketpath);
61 wait();
62}
63
64undef $TODO;
65# now test datagram sockets:
66$listener = IO::Socket::UNIX->new(Type => SOCK_DGRAM,
67 Local => $socketpath);
68ok(defined($listener), 'datagram socket created');
69
70$p = $listener->protocol();
71ok(defined($p), 'protocol defined');
72$d = $listener->sockdomain();
73ok(defined($d), 'domain defined');
74$s = $listener->socktype();
75ok(defined($s), 'type defined');
76
77my $new = IO::Socket::UNIX->new_from_fd($listener->fileno(), 'r+');
78
93a5d7bf
TC
79is($new->sockdomain(), $d, 'domain match');
80SKIP: {
81 skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });
82 is($new->protocol(), $p, 'protocol match');
83}
84SKIP: {
85 skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE });
86 is($new->socktype(), $s, 'type match');
87}
88unlink($socketpath);