[perl #111462] Don’t leak eval "" op tree when croaking

This patch only fixes the problem for croaks that occur in the peep-
hole optimiser or in Perl_finalize_optree.

It does this by doing SAVEFREEOP first and then restoring the
savestack index to its previous value afterwards (to void the effect
of SAVEFREEOP).

A more correct fix might be to do op_free in die_unwind before
POPEVAL, but I would have to do a lot more digging through the code
to tell whether that is safe.  I don’t feel comfortable with doing
that for 5.16.

This leak causes this warning on non-threaded debugging builds:

$ PERL_DESTRUCT_LEVEL=1 ./perl -Ilib -e 'BEGIN { $^H{foo} = bar } our %FIELDS; my main $x; eval q[$x->{foo}]'
Unbalanced string table refcount: (1) for "foo" during global destruction.

This problem does not affect the main program, because perl_destruct
frees PL_main_root.  It does not affect subroutines, as the op tree is
attached to the CV first, so freeing the CV frees the op tree.

diff --git a/op.c b/op.c
index 2ffe10f..1e6addb 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2768,6 +2768,7 @@ Perl_newPROG(pTHX_ OP *o)
 
     if (PL_in_eval) {
        PERL_CONTEXT *cx;
+       I32 i;
        if (PL_eval_root)
                return;
        PL_eval_root = newUNOP(OP_LEAVEEVAL,
@@ -2791,9 +2792,13 @@ Perl_newPROG(pTHX_ OP *o)
        PL_eval_root->op_private |= OPpREFCOUNTED;
        OpREFCNT_set(PL_eval_root, 1);
        PL_eval_root->op_next = 0;
+       i = PL_savestack_ix;
+       SAVEFREEOP(o);
+       ENTER;
        CALL_PEEP(PL_eval_start);
        finalize_optree(PL_eval_root);
-
+       LEAVE;
+       PL_savestack_ix = i;
     }
     else {
        if (o->op_type == OP_STUB) {

diff --git a/t/op/eval.t b/t/op/eval.t
index 5cd7f4c..e9a6996 100644 (file)
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan(tests => 125);
+plan(tests => 126);
 
 eval 'pass();';
 
@@ -596,3 +596,16 @@ EOP
 # SNMP::Trapinfo, when toke.c finds no syntax errors but perly.y fails.
 eval(q|""!=!~//|);
 pass("phew! dodged the assertion after a parsing (not lexing) error");
+
+# [perl #111462]
+{
+   local $ENV{PERL_DESTRUCT_LEVEL} = 1;
+   unlike
+     runperl(
+      prog => 'BEGIN { $^H{foo} = bar }'
+             .'our %FIELDS; my main $x; eval q[$x->{foo}]',
+      stderr => 1,
+     ),
+     qr/Unbalanced string table/,
+    'Errors in finalize_optree do not leak string eval op tree';
+}