This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
io_unix.t: make tests run on Windows builds if threads + AF_UNIX
authorRichard Leach <richardleach@users.noreply.github.com>
Thu, 12 Mar 2020 23:56:09 +0000 (23:56 +0000)
committerSawyer X <xsawyerx@cpan.org>
Wed, 20 May 2020 21:47:44 +0000 (00:47 +0300)
io_unix.t: simplify AF_UNIX check on Windows

io_unix.t: make tests run on Windows builds if threads + AF_UNIX

dist/IO/t/io_unix.t

index a6cd05c..93cddfb 100644 (file)
@@ -1,9 +1,16 @@
 #!./perl
 
 use Config;
+use IO::Socket;
 
 BEGIN {
     my $reason;
+    my $can_fork = $Config{d_fork} ||
+                   (($^O eq 'MSWin32' || $^O eq 'NetWare') and
+                    $Config{useithreads} and
+                    $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
+                   );
+
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bSocket\b/) {
        $reason = 'Socket extension unavailable';
     }
@@ -11,18 +18,25 @@ BEGIN {
        $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)$/ ) {
+    elsif ($^O =~ m/^(?:qnx|nto|vos)$/ ) {
        $reason = "UNIX domain sockets not implemented on $^O";
     }
-    elsif (! $Config{'d_fork'}) {
+    elsif (! $can_fork) {
        $reason = 'no fork';
     }
+    elsif ($^O eq 'MSWin32') {
+      if ($ENV{CONTINUOUS_INTEGRATION}) {
+         $reason = 'Skipping on Windows CI, see gh17575 and gh17429';
+      } else {
+       $reason = "AF_UNIX unavailable or disabled on this platform"
+         unless eval { socket(my $sock, PF_UNIX, SOCK_STREAM, 0) };
+      }
+    }
+
     if ($reason) {
        print "1..0 # Skip: $reason\n";
        exit 0;
@@ -50,8 +64,6 @@ unlink($PATH) or $^O eq 'os2' or die "Can't unlink $PATH: $!";
 $| = 1;
 print "1..5\n";
 
-use IO::Socket;
-
 $listen = IO::Socket::UNIX->new(Local => $PATH, Listen => 0);
 
 # Sometimes UNIX filesystems are mounted for security reasons