This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
test fails when sockets not available (from Yitzchak Scott-Thoennes)
[perl5.git] / t / lib / io_unix.t
CommitLineData
cf7fe8a2
GS
1#!./perl
2
3BEGIN {
4 unless(grep /blib/, @INC) {
5 chdir 't' if -d 't';
93430cb4 6 unshift @INC, '../lib' if -d '../lib';
cf7fe8a2
GS
7 }
8}
9
10use Config;
11
12BEGIN {
13 if(-d "lib" && -f "TEST") {
45c0de28
GS
14 my $reason;
15 if (! $Config{'d_fork'}) {
16 $reason = 'no fork';
17 }
18 elsif ($Config{'extensions'} !~ /\bSocket\b/) {
19 $reason = 'Socket extension unavailable';
20 }
21 elsif ($Config{'extensions'} !~ /\bIO\b/) {
22 $reason = 'IO extension unavailable';
23 }
4435c477 24 elsif ($^O eq 'os2') {
baba61ac 25 require IO::Socket;
4435c477
IZ
26
27 eval {IO::Socket::pack_sockaddr_un('/tmp/foo') || 1}
28 or $@ !~ /not implemented/ or
29 $reason = 'compiled without TCP/IP stack v4';
bb85248c
NA
30 } elsif ($^O eq 'qnx') {
31 $reason = 'Not implemented';
4435c477 32 }
45c0de28
GS
33 undef $reason if $^O eq 'VMS' and $Config{d_socket};
34 if ($reason) {
35 print "1..0 # Skip: $reason\n";
36 exit 0;
cf7fe8a2
GS
37 }
38 }
39}
40
41$PATH = "/tmp/sock-$$";
42
43# Test if we can create the file within the tmp directory
202975e6
IZ
44if (-e $PATH or not open(TEST, ">$PATH") and $^O ne 'os2') {
45 print "1..0 # Skip: cannot open '$PATH' for write\n";
cf7fe8a2
GS
46 exit 0;
47}
48close(TEST);
202975e6 49unlink($PATH) or $^O eq 'os2' or die "Can't unlink $PATH: $!";
cf7fe8a2
GS
50
51# Start testing
52$| = 1;
53print "1..5\n";
54
55use IO::Socket;
56
57$listen = IO::Socket::UNIX->new(Local=>$PATH, Listen=>0) || die "$!";
58print "ok 1\n";
59
60if($pid = fork()) {
61
62 $sock = $listen->accept();
63 print "ok 2\n";
64
65 print $sock->getline();
66
67 print $sock "ok 4\n";
68
69 $sock->close;
70
71 waitpid($pid,0);
202975e6 72 unlink($PATH) || $^O eq 'os2' || warn "Can't unlink $PATH: $!";
cf7fe8a2
GS
73
74 print "ok 5\n";
75
76} elsif(defined $pid) {
77
78 $sock = IO::Socket::UNIX->new(Peer => $PATH) or die "$!";
79
80 print $sock "ok 3\n";
81
82 print $sock->getline();
83
84 $sock->close;
85
86 exit;
87} else {
88 die;
89}