Stop run-time regexp blocks from leaking regexps

This was leaking like a sieve: $var = '(?{})'; /stuff$var/;

When a run-time regular expression has code blocks in it,
those are compiled separately inside their own qr thingy (see
S_compile_runtime_code in regcomp.c).

In re_op_compile, the newly-compiled code blocks are stored in
pRExC_state->code_blocks, which is a mallocked array.  That array also
holds reference counts on the regular expressions from which the code
blocks derive their existence.  When the whole regular expression is
compiled, the code blocks are fetched from that array, and the new
regular expression ends up holding a reference count on those code
block’s originating regular expressions.

The reference counts that pRExC_state->code_blocks had were not low-
ered when pRExC_state->code_blocks was freed, except for qr/stuff$var/
(because the qr// would take ownership of those reference counts,
which would be lowered when the outer qr// itself was freed).

diff --git a/regcomp.c b/regcomp.c
index e1b4ee6..9007b62 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -5870,7 +5870,13 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
        ri->num_code_blocks = pRExC_state->num_code_blocks;
     }
     else
+    {
+       int n;
+       for (n = 0; n < pRExC_state->num_code_blocks; n++)
+           if (pRExC_state->code_blocks[n].src_regex)
+               SAVEFREESV(pRExC_state->code_blocks[n].src_regex);
        SAVEFREEPV(pRExC_state->code_blocks);
+    }
 
     {
         bool has_p     = ((r->extflags & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY);

diff --git a/t/op/svleak.t b/t/op/svleak.t
index 914a2f3..a705587 100644 (file)
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -15,7 +15,7 @@ BEGIN {
 
 use Config;
 
-plan tests => 40;
+plan tests => 42;
 
 # 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
@@ -286,7 +286,8 @@ leak(2, 0, sub {
 
 # Run-time regexp code blocks
 {
-    my @tests = ('[(?{})]');
+    use re 'eval';
+    my @tests = ('[(?{})]','(?{})');
     for my $t (@tests) {
        leak(2, 0, sub {
            / $t/;