Retry _read() on EINTR, instead of losing pipe contents.

By not retrying, EINTR behaved like EOF.  In other words, EINTR had
consequences like the write side (kid side) closing the pipe early.
Symptoms depended on the _read() caller.  When $pipe_reader conflated
EINTR with pipe closure, symptoms were application-specific.  When
_spawn reading the internal "sync pipe" conflated EINTR with pipe
closure, the parent would fail to report exec failure.  Add a test for
the loss of exec failure report.  The $pipe_reader problem is much
tougher to test, because $pipe_reader only tries read() if select()
found data available.  Hence, the signal needs to arrive in the narrow
window after read() enters the kernel, before read() returns
already-available data.  The issue report reproduced that on macOS only.

Fixes #176

Author: nmisch

lib/IPC/Run.pm

@@ -1545,8 +1545,11 @@ sub _pty {
 sub _read {
     confess 'undef' unless defined $_[0];
     my $s = '';
-    my $r = POSIX::read( $_[0], $s, 10_000 );
-    croak "$!: read( $_[0] )" if not($r) and !$!{EINTR};
+    my $r;
+    do {
+        $r = POSIX::read( $_[0], $s, 10_000 );
+    } while ( !defined($r) && $!{EINTR} );
+    croak "$!: read( $_[0] )" unless defined($r);
     $r ||= 0;
     _debug "read( $_[0] ) = $r chars '$s'" if _debugging_data;
     return $s;
@@ -1567,6 +1570,13 @@ sub _spawn {
     croak "$! during fork" unless defined $kid->{PID};
 
     unless ( $kid->{PID} ) {
+        if ( $self->{_sigusr1_after_fork} ) {
+
+            # sleep 10ms to improve chance of parent starting read() before it
+            # handles the signal we're about to send.
+            select undef, undef, undef, 0.01;
+            kill 'USR1', getppid;
+        }
         ## _do_kid_and_exit closes sync_reader_fd since it closes all unwanted and
         ## unloved fds.
         $self->_do_kid_and_exit($kid);

t/eintr.t

@@ -4,7 +4,7 @@
 
 =head1 NAME
 
-eintr.t - Test select() failing with EINTR
+eintr.t - Test select() and read() failing with EINTR
 
 =cut
 
@@ -35,7 +35,7 @@ if ( $got_usr1 != 1 ) {
     plan skip_all => "can't deliver a signal on this platform";
 }
 
-plan tests => 3;
+plan tests => 5;
 
 # A kid that will send SIGUSR1 to this process and then produce some output.
 my $kid_perl = qq[sleep 1; kill 'USR1', $$; sleep 1; print "foo\n"; sleep 180];
@@ -59,3 +59,23 @@ is $got_usr1, 2, 'got USR1 from the kid';
 
 $harness->kill_kill;
 $harness->finish;
+
+# Have kid send SIGUSR1 while we're in read of sync pipe.  That pipe conveys any
+# exec failure to us.
+SKIP: {
+    if ( IPC::Run::Win32_MODE() ) {
+        skip "Can't really exec() $^O", 2;
+    }
+
+    my $expected = 'exec failed';
+    my $h        = eval {
+        start(
+            [ $^X, "-e", 1 ],
+            _sigusr1_after_fork    => 1,
+            _simulate_exec_failure => 1
+        );
+    };
+    my $got = $@ =~ $expected ? $expected : $@ || "";
+    is $got_usr1, 3, 'got USR1 from the _simulate_exec_failure kid';
+    is( $got, $expected, "reported exec failure despite USR1" );
+}