Re: [perl #32687] Encode::is_utf8 on tainted UTF8 string

[p5sagit/p5-mst-13.2.git] / toke.c

diff --git a/toke.c b/toke.c
index e34f796..ee7776f 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -677,6 +677,7 @@ Perl_lex_start(pTHX_ SV *line)
     SAVEDESTRUCTOR_X(restore_rsfp, PL_rsfp);
     SAVEINT(PL_expect);
 
+    PL_copline = NOLINE;
     PL_lex_state = LEX_NORMAL;
     PL_expect = XSTATE;
     Newx(parser->lex_brackstack, 120, char);
@@ -923,8 +924,7 @@ S_update_debugger_info(pTHX_ SV *orig_sv, const char *buf, STRLEN len)
 {
     AV *av = CopFILEAVx(PL_curcop);
     if (av) {
-       SV * const sv = newSV(0);
-       sv_upgrade(sv, SVt_PVMG);
+       SV * const sv = newSV_type(SVt_PVMG);
        if (orig_sv)
            sv_setsv(sv, orig_sv);
        else
@@ -1026,10 +1026,10 @@ S_skipspace(pTHX_ register char *s)
            /* XXX these shouldn't really be added here, can't set PL_faketokens */
            if (PL_minus_p) {
 #ifdef PERL_MAD
-               sv_catpv(PL_linestr,
+               sv_catpvs(PL_linestr,
                         ";}continue{print or die qq(-p destination: $!\\n);}");
 #else
-               sv_setpv(PL_linestr,
+               sv_setpvs(PL_linestr,
                         ";}continue{print or die qq(-p destination: $!\\n);}");
 #endif
                PL_minus_n = PL_minus_p = 0;
@@ -2024,7 +2024,7 @@ S_scan_const(pTHX_ char *start)
                    *d++ = NATIVE_TO_NEED(has_utf8,*s++);
            }
            else if (s[2] == '{' /* This should match regcomp.c */
-                    || ((s[2] == 'p' || s[2] == '?') && s[3] == '{'))
+                   || (s[2] == '?' && s[3] == '{'))
            {
                I32 count = 1;
                char *regparse = s + (s[2] == '{' ? 3 : 4);
@@ -2922,7 +2922,7 @@ S_readpipe_override(pTHX)
                && GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe))
            ||
            ((gvp = (GV**)hv_fetchs(PL_globalstash, "readpipe", FALSE))
-            && (gv_readpipe = *gvp) != (GV*)&PL_sv_undef
+            && (gv_readpipe = *gvp) && isGV_with_GP(gv_readpipe)
             && GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe)))
     {
        PL_lex_op = (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
@@ -3906,10 +3906,11 @@ Perl_yylex(pTHX)
 #endif
 #ifdef PERL_MAD
        PL_realtokenstart = -1;
-       s = SKIPSPACE0(s);
-#else
-       s++;
+       if (!PL_thiswhite)
+           PL_thiswhite = newSVpvs("");
+       sv_catpvn(PL_thiswhite, s, 1);
 #endif
+       s++;
        goto retry;
     case '#':
     case '\n':
@@ -4132,7 +4133,8 @@ Perl_yylex(pTHX)
            Mop(OP_MODULO);
        }
        PL_tokenbuf[0] = '%';
-       s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, TRUE);
+       s = scan_ident(s, PL_bufend, PL_tokenbuf + 1,
+               sizeof PL_tokenbuf - 1, FALSE);
        if (!PL_tokenbuf[1]) {
            PREREF('%');
        }
@@ -5165,7 +5167,7 @@ Perl_yylex(pTHX)
                }
                if (!ogv &&
                    (gvp = (GV**)hv_fetch(PL_globalstash,PL_tokenbuf,len,FALSE)) &&
-                   (gv = *gvp) != (GV*)&PL_sv_undef &&
+                   (gv = *gvp) && isGV_with_GP(gv) &&
                    GvCVu(gv) && GvIMPORTED_CV(gv))
                {
                    ogv = gv;
@@ -6599,8 +6601,8 @@ Perl_yylex(pTHX)
                    if (PL_madskills)
                        nametoke = newSVpvn(s, d - s);
 #endif
-                   if (strchr(tmpbuf, ':'))
-                       sv_setpv(PL_subname, tmpbuf);
+                   if (memchr(tmpbuf, ':', len))
+                       sv_setpvn(PL_subname, tmpbuf, len);
                    else {
                        sv_setsv(PL_subname,PL_curstname);
                        sv_catpvs(PL_subname,"::");
@@ -6986,7 +6988,11 @@ S_pending_ident(pTHX)
     if (pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) {
         GV *gv = gv_fetchpv(PL_tokenbuf+1, 0, SVt_PVAV);
         if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
-             && ckWARN(WARN_AMBIGUOUS))
+               && ckWARN(WARN_AMBIGUOUS)
+               /* DO NOT warn for @- and @+ */
+               && !( PL_tokenbuf[2] == '\0' &&
+                   ( PL_tokenbuf[1] == '-' || PL_tokenbuf[1] == '+' ))
+          )
         {
             /* Downgraded from fatal to warning 20000522 mjd */
             Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
@@ -11149,8 +11155,8 @@ S_scan_heredoc(pTHX_ register char *s)
        s--;
 #endif
 
-    tmpstr = newSV(79);
-    sv_upgrade(tmpstr, SVt_PVIV);
+    tmpstr = newSV_type(SVt_PVIV);
+    SvGROW(tmpstr, 80);
     if (term == '\'') {
        op_type = OP_CONST;
        SvIV_set(tmpstr, -1);
@@ -11377,7 +11383,7 @@ S_scan_inputsymbol(pTHX_ char *start)
                && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))
                ||
                ((gvp = (GV**)hv_fetchs(PL_globalstash, "readline", FALSE))
-               && (gv_readline = *gvp) != (GV*)&PL_sv_undef
+                && (gv_readline = *gvp) && isGV_with_GP(gv_readline)
                && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline)))
            readline_overriden = TRUE;
 
@@ -11555,8 +11561,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 
     /* create a new SV to hold the contents.  79 is the SV's initial length.
        What a random number. */
-    sv = newSV(79);
-    sv_upgrade(sv, SVt_PVIV);
+    sv = newSV_type(SVt_PVIV);
+    SvGROW(sv, 80);
     SvIV_set(sv, termcode);
     (void)SvPOK_only(sv);              /* validate pointer */
 
@@ -12384,8 +12390,7 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
     save_item(PL_subname);
     SAVESPTR(PL_compcv);
 
-    PL_compcv = (CV*)newSV(0);
-    sv_upgrade((SV *)PL_compcv, is_format ? SVt_PVFM : SVt_PVCV);
+    PL_compcv = (CV*)newSV_type(is_format ? SVt_PVFM : SVt_PVCV);
     CvFLAGS(PL_compcv) |= flags;
 
     PL_subline = CopLINE(PL_curcop);