From: Radu Greab <radu@netsoft.ro>
Date: Fri, 5 Jan 2001 21:04:33 +0000 (+0200)
Subject: Re: [ID 20010105.002] close() on process filehandle leaves defunct process
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=faa466a70c12a1db89a71755b531f086987f0862;p=p5sagit%2Fp5-mst-13.2.git

Re: [ID 20010105.002] close() on process filehandle leaves defunct process
Message-ID: <14934.6849.742435.23178@ix.netsoft.ro>

p4raw-id: //depot/perl@8340
---

diff --git a/t/io/pipe.t b/t/io/pipe.t
index 95cdd55..24c5d76 100755
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -11,7 +11,7 @@ BEGIN {
 }
 
 $| = 1;
-print "1..15\n";
+print "1..16\n";
 
 # External program 'tr' assumed.
 open(PIPE, "|-") || (exec 'tr', 'YX', 'ko');
@@ -185,3 +185,21 @@ if ($? != 42) {
 }
 print "ok 15\n";
 $? = 0;
+
+# check that child is reaped if the piped program can't be executed
+{
+  local $SIG{CHLD} = 'DEFAULT';
+  open NIL, '/no_such_process |';
+  close NIL;
+
+  my $child = 0;
+  eval {
+    local $SIG{ALRM} = sub { die; };
+    alarm 2;
+    $child = wait;
+    alarm 0;
+  };
+
+  print "not " if $child != -1;
+  print "ok 16\n";
+}
diff --git a/util.c b/util.c
index 60e82e3..1261b98 100644
--- a/util.c
+++ b/util.c
@@ -2455,8 +2455,12 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
 	PerlLIO_close(pp[0]);
 	did_pipes = 0;
 	if (n) {			/* Error */
+	    int pid2, status;
 	    if (n != sizeof(int))
 		Perl_croak(aTHX_ "panic: kid popen errno read");
+	    do {
+		pid2 = wait4pid(pid, &status, 0);
+	    } while (pid2 == -1 && errno == EINTR);
 	    errno = errkid;		/* Propagate errno from kid */
 	    return Nullfp;
 	}