From 4039933788b0393590f48aef41e9de5462fcc1e9 Mon Sep 17 00:00:00 2001 From: Yves Orton 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 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 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 Date: Fri Jun 10 13:34:37 2016 +0200 fixup, guard av_top_index() for null RExC_warn_text commit 222c4b0094b4145d06cb164bedd2a66a3141203b Author: Dan Collins Date: Wed Jun 8 16:26:07 2016 -0400 [perl #128313] test for memory leak in POSIX classes Signed-off-by: Petr Písař --- 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