b8876f
From 0cefeca1fd2405ad1b5544a3919e0000377fde5e Mon Sep 17 00:00:00 2001
b8876f
From: Tony Cook <tony@develop-help.com>
b8876f
Date: Tue, 21 Feb 2017 16:38:36 +1100
b8876f
Subject: [PATCH] (perl #130822) fix an AV leak in Perl_reg_named_buff_fetch
b8876f
MIME-Version: 1.0
b8876f
Content-Type: text/plain; charset=UTF-8
b8876f
Content-Transfer-Encoding: 8bit
b8876f
b8876f
Ported to 5.24.1:
b8876f
b8876f
commit 853eb961c1a3b014b5a9510740abc15ccd4383b6
b8876f
Author: Tony Cook <tony@develop-help.com>
b8876f
Date:   Tue Feb 21 16:38:36 2017 +1100
b8876f
b8876f
    (perl #130822) fix an AV leak in Perl_reg_named_buff_fetch
b8876f
b8876f
    Originally noted as a scoping issue by Andy Lester.
b8876f
b8876f
Signed-off-by: Petr Písař <ppisar@redhat.com>
b8876f
---
b8876f
 regcomp.c     |  5 +----
b8876f
 t/op/svleak.t | 12 +++++++++++-
b8876f
 2 files changed, 12 insertions(+), 5 deletions(-)
b8876f
b8876f
diff --git a/regcomp.c b/regcomp.c
b8876f
index 6329f6c..989c528 100644
b8876f
--- a/regcomp.c
b8876f
+++ b/regcomp.c
b8876f
@@ -7849,21 +7849,18 @@ SV*
b8876f
 Perl_reg_named_buff_fetch(pTHX_ REGEXP * const r, SV * const namesv,
b8876f
 			  const U32 flags)
b8876f
 {
b8876f
-    AV *retarray = NULL;
b8876f
     SV *ret;
b8876f
     struct regexp *const rx = ReANY(r);
b8876f
 
b8876f
     PERL_ARGS_ASSERT_REG_NAMED_BUFF_FETCH;
b8876f
 
b8876f
-    if (flags & RXapif_ALL)
b8876f
-        retarray=newAV();
b8876f
-
b8876f
     if (rx && RXp_PAREN_NAMES(rx)) {
b8876f
         HE *he_str = hv_fetch_ent( RXp_PAREN_NAMES(rx), namesv, 0, 0 );
b8876f
         if (he_str) {
b8876f
             IV i;
b8876f
             SV* sv_dat=HeVAL(he_str);
b8876f
             I32 *nums=(I32*)SvPVX(sv_dat);
b8876f
+            AV * const retarray = (flags & RXapif_ALL) ? newAV() : NULL;
b8876f
             for ( i=0; i
b8876f
                 if ((I32)(rx->nparens) >= nums[i]
b8876f
                     && rx->offs[nums[i]].start != -1
b8876f
diff --git a/t/op/svleak.t b/t/op/svleak.t
b8876f
index b0692ff..eeea7c1 100644
b8876f
--- a/t/op/svleak.t
b8876f
+++ b/t/op/svleak.t
b8876f
@@ -15,7 +15,7 @@ BEGIN {
b8876f
 
b8876f
 use Config;
b8876f
 
b8876f
-plan tests => 133;
b8876f
+plan tests => 134;
b8876f
 
b8876f
 # run some code N times. If the number of SVs at the end of loop N is
b8876f
 # greater than (N-1)*delta at the end of loop 1, we've got a leak
b8876f
@@ -557,3 +557,13 @@ EOF
b8876f
     sub lk { { my $d = $op->hints_hash->HASH } }
b8876f
     ::leak(3, 0, \&lk, q!B::RHE->HASH shoudln't leak!);
b8876f
 }
b8876f
+
b8876f
+{
b8876f
+    # Perl_reg_named_buff_fetch() leaks an AV when called with an RE
b8876f
+    # with no named captures
b8876f
+    sub named {
b8876f
+        "x" =~ /x/;
b8876f
+        re::regname("foo", 1);
b8876f
+    }
b8876f
+    ::leak(2, 0, \&named, "Perl_reg_named_buff_fetch() on no-name RE");
b8876f
+}
b8876f
-- 
b8876f
2.7.4
b8876f