Apply patch from Sprout to make vxs.inc better

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 8a53596..8ac0f31 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -482,7 +482,9 @@ S_printbuf(pTHX_ const char *const fmt, const char *const s)
 
     PERL_ARGS_ASSERT_PRINTBUF;
 
+    GCC_DIAG_IGNORE(-Wformat-nonliteral); /* fmt checked by caller */
     PerlIO_printf(Perl_debug_log, fmt, pv_display(tmp, s, strlen(s), 0, 60));
+    GCC_DIAG_RESTORE;
     SvREFCNT_dec(tmp);
 }
 
@@ -2744,7 +2746,8 @@ S_sublex_done(pTHX)
 
     /* Is there a right-hand side to take care of? (s//RHS/ or tr//RHS/) */
     assert(PL_lex_inwhat != OP_TRANSR);
-    if (PL_lex_repl && (PL_lex_inwhat == OP_SUBST || PL_lex_inwhat == OP_TRANS)) {
+    if (PL_lex_repl) {
+       assert (PL_lex_inwhat == OP_SUBST || PL_lex_inwhat == OP_TRANS);
        PL_linestr = PL_lex_repl;
        PL_lex_inpat = 0;
        PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
@@ -7110,7 +7113,8 @@ Perl_yylex(pTHX)
            if (PL_expect != XOPERATOR && (*s != ':' || s[1] != ':')) {
                CV *cv;
                if ((gv = gv_fetchpvn_flags(PL_tokenbuf, len,
-                                            UTF ? SVf_UTF8 : 0, SVt_PVCV)) &&
+                                           (UTF ? SVf_UTF8 : 0)|GV_NOTQUAL,
+                                           SVt_PVCV)) &&
                    (cv = GvCVu(gv)))
                {
                    if (GvIMPORTED_CV(gv))
@@ -7606,8 +7610,13 @@ Perl_yylex(pTHX)
                            while (isLOWER(*d))
                                d++;
                            if (!*d && !gv_stashpv(PL_tokenbuf, UTF ? SVf_UTF8 : 0))
+                            {
+                                /* PL_warn_reserved is constant */
+                                GCC_DIAG_IGNORE(-Wformat-nonliteral);
                                Perl_warner(aTHX_ packWARN(WARN_RESERVED), PL_warn_reserved,
                                       PL_tokenbuf);
+                                GCC_DIAG_RESTORE;
+                            }
                        }
                    }
                }
@@ -7883,7 +7892,8 @@ Perl_yylex(pTHX)
                *PL_tokenbuf = '&';
                d = scan_word(s, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1,
                              1, &len);
-               if (len && !keyword(PL_tokenbuf + 1, len, 0)) {
+               if (len && (len != 4 || strNE(PL_tokenbuf+1, "CORE"))
+                && !keyword(PL_tokenbuf + 1, len, 0)) {
                    d = SKIPSPACE1(d);
                    if (*d == '(') {
                        force_ident_maybe_lex('&');
@@ -9040,10 +9050,14 @@ S_pending_ident(pTHX)
             tmp = allocmy(PL_tokenbuf, tokenbuf_len, UTF ? SVf_UTF8 : 0);
         }
         else {
-            if (has_colon)
+            if (has_colon) {
+                /* PL_no_myglob is constant */
+                GCC_DIAG_IGNORE(-Wformat-nonliteral);
                 yyerror_pv(Perl_form(aTHX_ PL_no_myglob,
                            PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf),
                             UTF ? SVf_UTF8 : 0);
+                GCC_DIAG_RESTORE;
+            }
 
             pl_yylval.opval = newOP(OP_PADANY, 0);
             pl_yylval.opval->op_targ = allocmy(PL_tokenbuf, tokenbuf_len,