Stop ignored :lvalue warning from leaking CVs

When newMYSUB and newATTRSUB are called, PL_compcv has an unclaimed
reference count, so any code that croaks must decrement the reference
count or make arrangements for such to happen.

diff --git a/op.c b/op.c
index 1b4cf8d..aedf54f 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7038,7 +7038,12 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                    const bool pureperl = !CvISXSUB(cv) && CvROOT(cv);
                    if (CvLVALUE(compcv) && ! CvLVALUE(cv) && pureperl
                     && ckWARN(WARN_MISC))
+                   {
+                       /* protect against fatal warnings leaking compcv */
+                       SAVEFREESV(PL_compcv);
                        Perl_warner(aTHX_ packWARN(WARN_MISC), "lvalue attribute ignored after the subroutine has been defined");
+                       SvREFCNT_inc_simple_void_NN(PL_compcv);
+                   }
                    CvFLAGS(cv) |=
                        (CvFLAGS(compcv) & CVf_BUILTIN_ATTRS
                          & ~(CVf_LVALUE * pureperl));
@@ -7444,7 +7449,12 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
                    const bool pureperl = !CvISXSUB(cv) && CvROOT(cv);
                    if (CvLVALUE(PL_compcv) && ! CvLVALUE(cv) && pureperl
                     && ckWARN(WARN_MISC))
+                   {
+                       /* protect against fatal warnings leaking compcv */
+                       SAVEFREESV(PL_compcv);
                        Perl_warner(aTHX_ packWARN(WARN_MISC), "lvalue attribute ignored after the subroutine has been defined");
+                       SvREFCNT_inc_simple_void_NN(PL_compcv);
+                   }
                    CvFLAGS(cv) |=
                        (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS
                          & ~(CVf_LVALUE * pureperl));

diff --git a/t/op/svleak.t b/t/op/svleak.t
index 11ce8de..dee80ac 100644 (file)
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -78,12 +78,12 @@ eleak(2, 0, "$all /\$\\ /", '/$\ / with fatal warnings');
 eleak(2, 0, "$all s//\\1/", 's//\1/ with fatal warnings');
 eleak(2, 0, "$all qq|\\i|", 'qq|\i| with fatal warnings');
 eleak(2, 0, "$f 'digit'; qq|\\o{9}|", 'qq|\o{9}| with fatal warnings');
-$::TODO = 'still leaks';
 eleak(2, 0, "$f 'misc'; sub foo{} sub foo:lvalue",
      'ignored :lvalue with fatal warnings');
 eleak(2, 0, "no warnings; use feature ':all'; $f 'misc';
              my sub foo{} sub foo:lvalue",
      'ignored mysub :lvalue with fatal warnings');
+$::TODO = 'still leaks';
 eleak(2, 0, "no warnings; use feature ':all'; $all
              my sub foo{} sub foo:lvalue{}",
      'fatal mysub redef warning');