|
 |
4dad76 |
From fb5e77103dd443cc2112ba14dc665aa5ec072ce6 Mon Sep 17 00:00:00 2001
|
|
|
4dad76 |
From: Tony Cook <tony@develop-help.com>
|
|
|
4dad76 |
Date: Wed, 30 May 2018 14:03:04 +1000
|
|
|
4dad76 |
Subject: [PATCH] (perl #122112) test for signal handler death in pclose
|
|
|
4dad76 |
MIME-Version: 1.0
|
|
|
4dad76 |
Content-Type: text/plain; charset=UTF-8
|
|
|
4dad76 |
Content-Transfer-Encoding: 8bit
|
|
|
4dad76 |
|
|
|
4dad76 |
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
|
4dad76 |
---
|
|
|
4dad76 |
t/io/pipe.t | 23 ++++++++++++++++++++++-
|
|
|
4dad76 |
1 file changed, 22 insertions(+), 1 deletion(-)
|
|
|
4dad76 |
|
|
|
4dad76 |
diff --git a/t/io/pipe.t b/t/io/pipe.t
|
|
|
4dad76 |
index f9ee65afe8..1d01db6af6 100644
|
|
|
4dad76 |
--- a/t/io/pipe.t
|
|
|
4dad76 |
+++ b/t/io/pipe.t
|
|
|
4dad76 |
@@ -10,7 +10,7 @@ if (!$Config{'d_fork'}) {
|
|
|
4dad76 |
skip_all("fork required to pipe");
|
|
|
4dad76 |
}
|
|
|
4dad76 |
else {
|
|
|
4dad76 |
- plan(tests => 25);
|
|
|
4dad76 |
+ plan(tests => 27);
|
|
|
4dad76 |
}
|
|
|
4dad76 |
|
|
|
4dad76 |
my $Perl = which_perl();
|
|
|
4dad76 |
@@ -241,3 +241,24 @@ SKIP: {
|
|
|
4dad76 |
|
|
|
4dad76 |
is($child, -1, 'child reaped if piped program cannot be executed');
|
|
|
4dad76 |
}
|
|
|
4dad76 |
+
|
|
|
4dad76 |
+{
|
|
|
4dad76 |
+ # [perl #122112] refcnt: fd -1 < 0 when a signal handler dies
|
|
|
4dad76 |
+ # while a pipe close is waiting on a child process
|
|
|
4dad76 |
+ my $prog = <
|
|
|
4dad76 |
+\$SIG{ALRM}=sub{die};
|
|
|
4dad76 |
+alarm 1;
|
|
|
4dad76 |
+\$Perl = "$Perl";
|
|
|
4dad76 |
+my \$cmd = qq(\$Perl -e "sleep 3");
|
|
|
4dad76 |
+my \$pid = open my \$fh, "|\$cmd" or die "\$!\n";
|
|
|
4dad76 |
+close \$fh;
|
|
|
4dad76 |
+PROG
|
|
|
4dad76 |
+ print $prog;
|
|
|
4dad76 |
+ my $out = fresh_perl($prog, {});
|
|
|
4dad76 |
+ $::TODO = "not fixed yet";
|
|
|
4dad76 |
+ cmp_ok($out, '!~', qr/refcnt/, "no exception from PerlIO");
|
|
|
4dad76 |
+ undef $::TODO;
|
|
|
4dad76 |
+ # checks that that program did something rather than failing to
|
|
|
4dad76 |
+ # compile
|
|
|
4dad76 |
+ cmp_ok($out, '=~', qr/Died at/, "but we did get the exception from die");
|
|
|
4dad76 |
+}
|
|
|
4dad76 |
--
|
|
|
4dad76 |
2.20.1
|
|
|
4dad76 |
|