Silence some warnings introduced by #33507

[p5sagit/p5-mst-13.2.git] / ext / IO / t / io_unix.t

diff --git a/ext/IO/t/io_unix.t b/ext/IO/t/io_unix.t
index e0a742f..33ee056 100644 (file)
--- a/ext/IO/t/io_unix.t
+++ b/ext/IO/t/io_unix.t
@@ -10,35 +10,41 @@ BEGIN {
 use Config;
 
 BEGIN {
-    if(-d "lib" && -f "TEST") {
-       my $reason;
-       if (! $Config{'d_fork'}) {
-           $reason = 'no fork';
-       }
-       elsif ($Config{'extensions'} !~ /\bSocket\b/) {
-           $reason = 'Socket extension unavailable';
-       }
-       elsif ($Config{'extensions'} !~ /\bIO\b/) {
-           $reason = 'IO extension unavailable';
-       }
-       elsif ($^O eq 'os2') {
-           require IO::Socket;
-
-           eval {IO::Socket::pack_sockaddr_un('/foo/bar') || 1}
-             or $@ !~ /not implemented/ or
-               $reason = 'compiled without TCP/IP stack v4';
-       } elsif ($^O =~ m/^(?:qnx|nto|vos)$/ ) {
-           $reason = 'Not implemented';
-       }
-       if ($reason) {
-           print "1..0 # Skip: $reason\n";
-           exit 0;
-        }
+    my $reason;
+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bSocket\b/) {
+       $reason = 'Socket extension unavailable';
+    }
+    elsif ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
+       $reason = 'IO extension unavailable';
+    }
+    elsif ($^O eq 'os2') {
+       require IO::Socket;
+
+       eval {IO::Socket::pack_sockaddr_un('/foo/bar') || 1}
+         or $@ !~ /not implemented/ or
+           $reason = 'compiled without TCP/IP stack v4';
+    }
+    elsif ($^O =~ m/^(?:qnx|nto|vos|MSWin32)$/ ) {
+       $reason = "UNIX domain sockets not implemented on $^O";
+    }
+    elsif (! $Config{'d_fork'}) {
+       $reason = 'no fork';
+    }
+    if ($reason) {
+       print "1..0 # Skip: $reason\n";
+       exit 0;
     }
 }
 
 $PATH = "sock-$$";
 
+if ($^O eq 'os2') {    # Can't create sockets with relative path...
+  require Cwd;
+  my $d = Cwd::cwd();
+  $d =~ s/^[a-z]://i;
+  $PATH = "$d/$PATH";
+}
+
 # Test if we can create the file within the tmp directory
 if (-e $PATH or not open(TEST, ">$PATH") and $^O ne 'os2') {
     print "1..0 # Skip: cannot open '$PATH' for write\n";
@@ -53,7 +59,26 @@ print "1..5\n";
 
 use IO::Socket;
 
-$listen = IO::Socket::UNIX->new(Local=>$PATH, Listen=>0) || die "$!";
+$listen = IO::Socket::UNIX->new(Local => $PATH, Listen => 0);
+
+# Sometimes UNIX filesystems are mounted for security reasons
+# with "nodev" option which spells out "no" for creating UNIX
+# local sockets.  Therefore we will retry with a File::Temp
+# generated filename from a temp directory.
+unless (defined $listen) {
+    eval { require File::Temp };
+    unless ($@) {
+       import File::Temp 'mktemp';
+       for my $TMPDIR ($ENV{TMPDIR}, "/tmp") {
+           if (defined $TMPDIR && -d $TMPDIR && -w $TMPDIR) {
+               $PATH = mktemp("$TMPDIR/sXXXXXXXX");
+               last if $listen = IO::Socket::UNIX->new(Local => $PATH,
+                                                       Listen => 0);
+           }
+       }
+    }
+    defined $listen or die "$PATH: $!";
+}
 print "ok 1\n";
 
 if($pid = fork()) {