Disallow sprintf's vector handling for non-integer formats.

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index ba3fbb1..5a0a5b3 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -26,12 +26,7 @@
 #define yychar (*PL_yycharp)
 #define yylval (*PL_yylvalp)
 
-static const char ident_too_long[] =
-  "Identifier too long";
-static const char c_without_g[] =
-  "Use of /c modifier is meaningless without /g";
-static const char c_in_subst[] =
-  "Use of /c modifier is meaningless in s///";
+static const char ident_too_long[] = "Identifier too long";
 
 static void restore_rsfp(pTHX_ void *f);
 #ifndef PERL_NO_UTF16_FILTER
@@ -141,7 +136,7 @@ static const char* const lex_state_names[] = {
  */
 
 #ifdef DEBUGGING /* Serve -DT. */
-#   define REPORT(retval) tokereport(s,(int)retval)
+#   define REPORT(retval) tokereport((I32)retval)
 #else
 #   define REPORT(retval) (retval)
 #endif
@@ -282,7 +277,7 @@ static struct debug_tokens { const int token, type; const char *name; }
 /* dump the returned token in rv, plus any optional arg in yylval */
 
 STATIC int
-S_tokereport(pTHX_ const char* s, I32 rv)
+S_tokereport(pTHX_ I32 rv)
 {
     if (DEBUG_T_TEST) {
        const char *name = Nullch;
@@ -344,7 +339,7 @@ S_tokereport(pTHX_ const char* s, I32 rv)
 STATIC void
 S_printbuf(pTHX_ const char* fmt, const char* s)
 {
-    SV* tmp = newSVpvn("", 0);
+    SV* const tmp = newSVpvn("", 0);
     PerlIO_printf(Perl_debug_log, fmt, pv_display(tmp, s, strlen(s), 0, 60));
     SvREFCNT_dec(tmp);
 }
@@ -680,14 +675,14 @@ S_incline(pTHX_ char *s)
     *t = '\0';
     if (t - s > 0) {
 #ifndef USE_ITHREADS
-       const char *cf = CopFILE(PL_curcop);
-       if (cf && strlen(cf) > 7 && strnEQ(cf, "(eval ", 6)) {
+       const char * const cf = CopFILE(PL_curcop);
+       STRLEN tmplen = cf ? strlen(cf) : 0;
+       if (tmplen > 7 && strnEQ(cf, "(eval ", 6)) {
            /* must copy *{"::_<(eval N)[oldfilename:L]"}
             * to *{"::_<newfilename"} */
            char smallbuf[256], smallbuf2[256];
            char *tmpbuf, *tmpbuf2;
            GV **gvp, *gv2;
-           STRLEN tmplen = strlen(cf);
            STRLEN tmplen2 = strlen(s);
            if (tmplen + 3 < sizeof smallbuf)
                tmpbuf = smallbuf;
@@ -2651,10 +2646,9 @@ Perl_yylex(pTHX)
            PL_last_uni = 0;
            PL_last_lop = 0;
            if (PL_lex_brackets) {
-               if (PL_lex_formbrack)
-                   yyerror("Format not terminated");
-                else
-                   yyerror("Missing right curly or square bracket");
+               yyerror(PL_lex_formbrack
+                   ? "Format not terminated"
+                   : "Missing right curly or square bracket");
            }
             DEBUG_T( { PerlIO_printf(Perl_debug_log,
                         "### Tokener got EOF\n");
@@ -3106,7 +3100,7 @@ Perl_yylex(pTHX)
            if (ftst) {
                PL_last_lop_op = (OPCODE)ftst;
                DEBUG_T( { PerlIO_printf(Perl_debug_log,
-                        "### Saw file test %c\n", (int)ftst);
+                        "### Saw file test %c\n", (int)tmp);
                } );
                FTST(ftst);
            }
@@ -3319,11 +3313,9 @@ Perl_yylex(pTHX)
                   context messages from yyerror().
                 */
                PL_bufptr = s;
-               if (!*s)
-                   yyerror("Unterminated attribute list");
-               else
-                   yyerror(Perl_form(aTHX_ "Invalid separator character %c%c%c in attribute list",
-                                     q, *s, q));
+               yyerror( *s
+                   ? Perl_form(aTHX_ "Invalid separator character %c%c%c in attribute list", q, *s, q)
+                   : "Unterminated attribute list" );
                if (attrs)
                    op_free(attrs);
                OPERATOR(':');
@@ -4272,11 +4264,16 @@ Perl_yylex(pTHX)
 
                    /* If not a declared subroutine, it's an indirect object. */
                    /* (But it's an indir obj regardless for sort.) */
+                   /* Also, if "_" follows a filetest operator, it's a bareword */
 
-                   if ( !immediate_paren && (PL_last_lop_op == OP_SORT ||
+                   if (
+                       ( !immediate_paren && (PL_last_lop_op == OP_SORT ||
                          ((!gv || !GvCVu(gv)) &&
                         (PL_last_lop_op != OP_MAPSTART &&
                         PL_last_lop_op != OP_GREPSTART))))
+                      || (PL_tokenbuf[0] == '_' && PL_tokenbuf[1] == '\0'
+                           && ((PL_opargs[PL_last_lop_op] & OA_CLASS_MASK) == OA_FILESTATOP))
+                      )
                    {
                        PL_expect = (PL_last_lop == PL_oldoldbufptr) ? XTERM : XOPERATOR;
                        goto bareword;
@@ -9362,7 +9359,7 @@ S_scan_pat(pTHX_ char *start, I32 type)
     if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL)
            && ckWARN(WARN_REGEXP))
     {
-        Perl_warner(aTHX_ packWARN(WARN_REGEXP), c_without_g);
+        Perl_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless without /g" );
     }
 
     pm->op_pmpermflags = pm->op_pmflags;
@@ -9414,10 +9411,8 @@ S_scan_subst(pTHX_ char *start)
            break;
     }
 
-    /* /c is not meaningful with s/// */
-    if ((pm->op_pmflags & PMf_CONTINUE) && ckWARN(WARN_REGEXP))
-    {
-        Perl_warner(aTHX_ packWARN(WARN_REGEXP), c_in_subst);
+    if ((pm->op_pmflags & PMf_CONTINUE) && ckWARN(WARN_REGEXP)) {
+        Perl_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless in s///" );
     }
 
     if (es) {
@@ -10927,7 +10922,7 @@ S_swallow_bom(pTHX_ U8 *s)
 static void
 restore_rsfp(pTHX_ void *f)
 {
-    PerlIO *fp = (PerlIO*)f;
+    PerlIO * const fp = (PerlIO*)f;
 
     if (PL_rsfp == PerlIO_stdin())
        PerlIO_clearerr(PL_rsfp);
@@ -11015,16 +11010,15 @@ Perl_scan_vstring(pTHX_ const char *s, SV *sv)
     }
 
     if (!isALPHA(*pos)) {
-       UV rev;
        U8 tmpbuf[UTF8_MAXBYTES+1];
-       U8 *tmpend;
 
        if (*s == 'v') s++;  /* get past 'v' */
 
        sv_setpvn(sv, "", 0);
 
        for (;;) {
-           rev = 0;
+           U8 *tmpend;
+           UV rev = 0;
            {
                /* this is atoi() that tolerates underscores */
                const char *end = pos;