perl/perl-5.24.0-Fix-a-memory-leak-in-strict-regex-posix-classes.patch

From 4039933788b0393590f48aef41e9de5462fcc1e9 Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Wed, 8 Jun 2016 18:42:30 +0200
Subject: [PATCH] Fix a memory leak in strict regex posix classes
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This is a perl-5.24.0 port of these four upstream patches fixing RT#128313:

commit ee072c898947f5fee316f1381b29ad692addcf05
Author: Yves Orton <demerphq@gmail.com>
Date:   Wed Jun 8 18:42:30 2016 +0200

    [perl #128313] Fix leak in perl 5.24 with strict and regex posix char classes

    This patch is a refinement of one written by Dan Collins.

    Any thanks for this patch should go to him.

commit 7eec73eb790f7c4982edfc28c17c011e8a072490
Author: Yves Orton <demerphq@gmail.com>
Date:   Fri Jun 10 12:20:20 2016 +0200

    move warning text to RExC_state (via RExC_warn_text)

    This way we reuse the same AV each time, and avoid various refcount bookkeeping issues, all at a relatively modest cost (IMO)

commit 0bf54b1ecaec8f6d80845d6cb77d62f8c9f4c415
Author: Yves Orton <demerphq@gmail.com>
Date:   Fri Jun 10 13:34:37 2016 +0200

    fixup, guard av_top_index() for null RExC_warn_text

commit 222c4b0094b4145d06cb164bedd2a66a3141203b
Author: Dan Collins <dcollinsn@gmail.com>
Date:   Wed Jun 8 16:26:07 2016 -0400

    [perl #128313] test for memory leak in POSIX classes

Signed-off-by: Petr Písař <ppisar@redhat.com>
---
 regcomp.c     | 21 ++++++++++-----------
 t/op/svleak.t | 12 +++++++++++-
 2 files changed, 21 insertions(+), 12 deletions(-)

diff --git a/regcomp.c b/regcomp.c
index be6cb96..f29892c 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -199,6 +199,7 @@ struct RExC_state_t {
     scan_frame *frame_head;
     scan_frame *frame_last;
     U32         frame_count;
+    AV         *warn_text;
 #ifdef ADD_TO_REGEXEC
     char 	*starttry;		/* -Dr: where regtry was called. */
 #define RExC_starttry	(pRExC_state->starttry)
@@ -288,6 +289,7 @@ struct RExC_state_t {
 #define RExC_frame_last (pRExC_state->frame_last)
 #define RExC_frame_count (pRExC_state->frame_count)
 #define RExC_strict (pRExC_state->strict)
+#define RExC_warn_text (pRExC_state->warn_text)
 
 /* Heuristic check on the complexity of the pattern: if TOO_NAUGHTY, we set
  * a flag to disable back-off on the fixed/floating substrings - if it's
@@ -6767,6 +6769,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
 #endif
     }
 
+    pRExC_state->warn_text = NULL;
     pRExC_state->code_blocks = NULL;
     pRExC_state->num_code_blocks = 0;
 
@@ -13704,8 +13707,8 @@ S_populate_ANYOF_from_invlist(pTHX_ regnode *node, SV** invlist_ptr)
  * routine. q.v. */
 #define ADD_POSIX_WARNING(p, text)  STMT_START {                            \
         if (posix_warnings) {                                               \
-            if (! warn_text) warn_text = newAV();                           \
-            av_push(warn_text, Perl_newSVpvf(aTHX_                          \
+            if (! RExC_warn_text ) RExC_warn_text = (AV *) sv_2mortal((SV *) newAV()); \
+            av_push(RExC_warn_text, Perl_newSVpvf(aTHX_                          \
                                              WARNING_PREFIX                 \
                                              text                           \
                                              REPORT_LOCATION,               \
@@ -13836,7 +13839,6 @@ S_handle_possible_posix(pTHX_ RExC_state_t *pRExC_state,
     bool has_opening_colon    = FALSE;
     int class_number          = OOB_NAMEDCLASS; /* Out-of-bounds until find
                                                    valid class */
-    AV* warn_text             = NULL;   /* any warning messages */
     const char * possible_end = NULL;   /* used for a 2nd parse pass */
     const char* name_start;             /* ptr to class name first char */
 
@@ -13852,6 +13854,9 @@ S_handle_possible_posix(pTHX_ RExC_state_t *pRExC_state,
 
     PERL_ARGS_ASSERT_HANDLE_POSSIBLE_POSIX;
 
+    if (posix_warnings && RExC_warn_text)
+        av_clear(RExC_warn_text);
+
     if (p >= e) {
         return NOT_MEANT_TO_BE_A_POSIX_CLASS;
     }
@@ -14469,14 +14474,8 @@ S_handle_possible_posix(pTHX_ RExC_state_t *pRExC_state,
                 ADD_POSIX_WARNING(p, "there is no terminating ']'");
             }
 
-            if (warn_text) {
-                if (posix_warnings) {
-                    /* mortalize to avoid a leak with FATAL warnings */
-                    *posix_warnings = (AV *) sv_2mortal((SV *) warn_text);
-                }
-                else {
-                    SvREFCNT_dec_NN(warn_text);
-                }
+            if (posix_warnings && RExC_warn_text && av_top_index(RExC_warn_text) > -1) {
+                *posix_warnings = RExC_warn_text;
             }
         }
         else if (class_number != OOB_NAMEDCLASS) {
diff --git a/t/op/svleak.t b/t/op/svleak.t
index 595bf3e..c18f498 100644
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -15,7 +15,7 @@ BEGIN {
 
 use Config;
 
-plan tests => 131;
+plan tests => 132;
 
 # run some code N times. If the number of SVs at the end of loop N is
 # greater than (N-1)*delta at the end of loop 1, we've got a leak
@@ -537,3 +537,13 @@ EOF
 
     ::leak(5, 0, \&f, q{goto shouldn't leak @_});
 }
+
+# [perl #128313] POSIX warnings shouldn't leak
+{
+    no warnings 'experimental';
+    use re 'strict';
+    my $a = 'aaa';
+    my $b = 'aa';
+    sub f { $a =~ /[^.]+$b/; }
+    ::leak(2, 0, \&f, q{use re 'strict' shouldn't leak warning strings});
+}
-- 
2.5.5