On Windows, avoid hang when closing read end of pipe.

As part of reproducing the defect, this slows t/run.t by 1s.

Fixes cpan-authors#77

lib/IPC/Run.pm

@@ -1273,6 +1273,40 @@ sub _empty($) { !( defined $_[0] && length $_[0] ) }
 sub _close {
     confess 'undef' unless defined $_[0];
     my $fd = $_[0] =~ /^\d+$/ ? $_[0] : fileno $_[0];
+    if (Win32_MODE) {
+
+        # Perl close() or POSIX::close() on the read end of a pipe hangs if
+        # another process is in a read attempt on the same pipe
+        # (https://github.com/Perl/perl5/issues/19963).  Since IPC::Run creates
+        # pipes and shares them with user-defined kids, it's affected.  Work
+        # around that by first using dup2() to replace the FD with a non-pipe.
+        # Unfortunately, for socket FDs, dup2() closes the SOCKET with
+        # CloseHandle().  CloseHandle() documentation leaves its behavior
+        # undefined for sockets.  However, tests on Windows Server 2022 did not
+        # leak memory, leak ports, or reveal any other obvious trouble.
+        #
+        # No failure here is fatal.  (_close() has worked that way, either due
+        # to a principle or just due to a history of callers passing closed
+        # FDs.)  croak() on EMFILE would be a bad user experience.  Better to
+        # proceed and hope that $fd is not a being-read pipe.
+        #
+        # Since start() and other user-facing methods _close() many FDs, we
+        # could optimize this by opening and closing the non-pipe FD just once
+        # per method call.  The overhead of this simple approach was in the
+        # noise, however.
+        my $nul_fd = POSIX::open 'NUL';
+        if ( !defined $nul_fd ) {
+            _debug "open( NUL ) = ERROR $!" if _debugging_details;
+        }
+        else {
+            my $r = POSIX::dup2( $nul_fd, $fd );
+            _debug "dup2( $nul_fd, $fd ) = ERROR $!"
+              if _debugging_details && !defined $r;
+            $r = POSIX::close $nul_fd;
+            _debug "close( $nul_fd (NUL) ) = ERROR $!"
+              if _debugging_details && !defined $r;
+        }
+    }
     my $r = POSIX::close $fd;
     $r = $r ? '' : " ERROR $!";
     delete $fds{$fd};
@@ -2836,6 +2870,11 @@ sub start {
                         $kid->{OPS},
                     );
                     _debug "spawn() = ", $kid->{PID} if _debugging;
+                    if ($self->{_sleep_after_win32_spawn}) {
+                      sleep $self->{_sleep_after_win32_spawn};
+                      _debug "after sleep $self->{_sleep_after_win32_spawn}"
+                          if _debugging;
+                    }
                 }
             };
             if ($@) {

lib/IPC/Run/Win32IO.pm

@@ -358,8 +358,11 @@ sub _spawn_pumper {
     #   close SAVEOUT            or croak "$! closing SAVEOUT";       #### ADD
     #   close SAVEERR            or croak "$! closing SAVEERR";       #### ADD
 
-    close $stdin  or croak "$! closing pumper's stdin in parent";
-    close $stdout or croak "$! closing pumper's stdout in parent";
+    # In case of a sleep right here, need the IPC::Run::_close() treatment.
+    IPC::Run::_close fileno($stdin);
+    close $stdin;
+    IPC::Run::_close fileno($stdout);
+    close $stdout;
 
     # Don't close $debug_fd, we need it, as do other pumpers.
 

t/run.t

@@ -1028,6 +1028,9 @@ $fd_map = _map_fds;
 $h      = start(
     [ @perl, '-pe', 'BEGIN { $| = 1 } print STDERR uc($_)' ],
     \$in, \$out, \$err,
+
+    # hangs w/o fix for https://github.com/toddr/IPC-Run/issues/77
+    _sleep_after_win32_spawn => 1,
 );
 isa_ok( $h, 'IPC::Run' );
 is( $?, 99 );