Stop / $looks_like_block/ from leaking

If an interpolated string looks as though it contains a regexp code
block, the regexp compiler will evaluate it inside qr'...' and then
extract the code blocks from the resulting regexp object.

If it turned out to be a false positive (e.g., "[(?{})]"), then
the code to handle this returned without freeing the temporary reg-
exp object.

diff --git a/regcomp.c b/regcomp.c
index 7114355..e1b4ee6 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -5129,7 +5129,10 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state,
        int i1 = 0, i2 = 0;
 
        if (!r2->num_code_blocks) /* we guessed wrong */
+       {
+           SvREFCNT_dec(qr);
            return 1;
+       }
 
        Newx(new_block,
            r1->num_code_blocks + r2->num_code_blocks,

diff --git a/t/op/svleak.t b/t/op/svleak.t
index b5bd1c1..914a2f3 100644 (file)
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -15,7 +15,7 @@ BEGIN {
 
 use Config;
 
-plan tests => 38;
+plan tests => 40;
 
 # 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
@@ -282,3 +282,17 @@ leak(2, 0, sub {
     my @a;
     eval { push @a, $die_on_fetch };
 }, 'pushing exploding scalar does not leak');
+
+
+# Run-time regexp code blocks
+{
+    my @tests = ('[(?{})]');
+    for my $t (@tests) {
+       leak(2, 0, sub {
+           / $t/;
+       }, "/ \$x/ where \$x is $t does not leak");
+       leak(2, 0, sub {
+           /(?{})$t/;
+       }, "/(?{})\$x/ where \$x is $t does not leak");
+    }
+}