From 35608a1658fe75c79ca53d96aea6cf7cb2a98615 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Thu, 9 May 2019 09:52:30 +1000 Subject: [PATCH] (perl #122112) a simpler fix for pclose() aborted by a signal MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This change results in a zombie child process for the lifetime of the process, but I think that's the responsibility of the signal handler that aborted pclose(). We could add some magic to retry (and retry and retry) waiting on child process as we rewind (since there's no other way to remove the zombie), but the program has chosen implicitly to abort the wait() done by pclose() and it's best to honor that. If we do choose to retry the wait() we might be blocking an attempt by the process to terminate, whether by exit() or die(). If a program does need more flexible handling there's always pipe()/fork()/exec() and/or the various event-driven frameworks on CPAN. Signed-off-by: Petr Písař --- doio.c | 12 +++++++++++- t/io/pipe.t | 2 -- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/doio.c b/doio.c index 0cc4e55404..05a06968dc 100644 --- a/doio.c +++ b/doio.c @@ -1779,7 +1779,17 @@ Perl_io_close(pTHX_ IO *io, GV *gv, bool not_implicit, bool warn_on_fail) if (IoIFP(io)) { if (IoTYPE(io) == IoTYPE_PIPE) { - const int status = PerlProc_pclose(IoIFP(io)); + PerlIO *fh = IoIFP(io); + int status; + + /* my_pclose() can propagate signals which might bypass any code + after the call here if the signal handler throws an exception. + This would leave the handle in the IO object and try to close it again + when the SV is destroyed on unwind or global destruction. + So NULL it early. + */ + IoOFP(io) = IoIFP(io) = NULL; + status = PerlProc_pclose(fh); if (not_implicit) { STATUS_NATIVE_CHILD_SET(status); retval = (STATUS_UNIX == 0); diff --git a/t/io/pipe.t b/t/io/pipe.t index 1d01db6af6..fc3071300d 100644 --- a/t/io/pipe.t +++ b/t/io/pipe.t @@ -255,9 +255,7 @@ close \$fh; PROG print $prog; my $out = fresh_perl($prog, {}); - $::TODO = "not fixed yet"; cmp_ok($out, '!~', qr/refcnt/, "no exception from PerlIO"); - undef $::TODO; # checks that that program did something rather than failing to # compile cmp_ok($out, '=~', qr/Died at/, "but we did get the exception from die"); -- 2.20.1