Stop toke.c:S_scan_const from leaking
authorFather Chrysostomos <sprout@cpan.org>
Sat, 24 Nov 2012 01:54:09 +0000 (17:54 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 24 Nov 2012 01:54:09 +0000 (17:54 -0800)
Fatal warnings and errors can cause the string buffer used when
scanning a quote-like operator to leak.  This commit fixes it
by using the savestack.  There are still a few leaks from that
code path that are not fixed by this.

t/op/svleak.t
toke.c

index 2a2e31c..11ce8de 100644 (file)
@@ -72,13 +72,13 @@ leak(5, 1, sub {push @a,1;},       "basic check 3 of leak test infrastructure");
 # Fatal warnings
 my $f = "use warnings FATAL =>";
 my $all = "$f 'all';";
-$::TODO = 'still leaks';
 eleak(2, 0, "$f 'deprecated'; qq|\\c\{|", 'qq|\c{| with fatal warnings');
 eleak(2, 0, "$f 'syntax'; qq|\\c`|", 'qq|\c`| with fatal warnings');
 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';
@@ -272,14 +272,16 @@ eleak(2, 0, 'no warnings; 2 2;BEGIN{}',
 }
 eleak(2, 0, "\"\$\0\356\"", 'qq containing $ <null> something');
 eleak(2, 0, 'END OF TERMS AND CONDITIONS', 'END followed by words');
-$::TODO = 'still leaks';
 eleak(2, 0, "qq|\\c|;"x10,     '"too many errors" from qq"\c"');
+$::TODO = 'still leaks';
 eleak(2, 0, "qq|\\N{%}|"x10,   '"too many errors" from qq"\N{%}"');
+undef $::TODO;
 eleak(2, 0, "qq|\\o|;"x10,     '"too many errors" from qq"\o"');
 eleak(2, 0, "qq|\\x{|;"x10,    '"too many errors" from qq"\x{"');
 eleak(2, 0, "qq|\\N|;"x10,     '"too many errors" from qq"\N"');
 eleak(2, 0, "qq|\\N{|;"x10,    '"too many errors" from qq"\N{"');
 eleak(2, 0, "qq|\\N{U+GETG}|;"x10,'"too many errors" from qq"\N{U+JUNK}"');
+$::TODO = 'still leaks';
 eleak(2, 0, "qq|\\N{au}|;"x10, '"too many errors" from qq"\N{invalid}"');
 undef $::TODO;
 
diff --git a/toke.c b/toke.c
index 902f83c..32367bc 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2966,6 +2966,9 @@ S_scan_const(pTHX_ char *start)
        this_utf8  = PL_sublex_info.sub_op->op_private & (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF);
     }
 
+    /* Protect sv from errors and fatal warnings. */
+    ENTER_with_name("scan_const");
+    SAVEFREESV(sv);
 
     while (s < send || dorange) {
 
@@ -3037,7 +3040,6 @@ S_scan_const(pTHX_ char *start)
 #endif
 
                 if (min > max) {
-                   SvREFCNT_dec(sv);
                    Perl_croak(aTHX_
                               "Invalid range \"%c-%c\" in transliteration operator",
                               (char)min, (char)max);
@@ -3096,7 +3098,6 @@ S_scan_const(pTHX_ char *start)
            /* range begins (ignore - as first or last char) */
            else if (*s == '-' && s+1 < send  && s != start) {
                if (didrange) {
-                   SvREFCNT_dec(sv);
                    Perl_croak(aTHX_ "Ambiguous range in transliteration operator");
                }
                if (has_utf8
@@ -3723,6 +3724,7 @@ S_scan_const(pTHX_ char *start)
 
     /* return the substring (via pl_yylval) only if we parsed anything */
     if (s > PL_bufptr) {
+       SvREFCNT_inc_simple_void_NN(sv);
        if ( PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) ) {
            const char *const key = PL_lex_inpat ? "qr" : "q";
            const STRLEN keylen = PL_lex_inpat ? 2 : 1;
@@ -3747,8 +3749,8 @@ S_scan_const(pTHX_ char *start)
                                type, typelen);
        }
        pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
-    } else
-       SvREFCNT_dec(sv);
+    }
+    LEAVE_with_name("scan_const");
     return s;
 }