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