This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
toke.c: Add limit parameter to 3 static functions
authorKarl Williamson <khw@cpan.org>
Mon, 6 Nov 2017 21:12:41 +0000 (14:12 -0700)
committerKarl Williamson <khw@cpan.org>
Mon, 6 Nov 2017 21:31:45 +0000 (14:31 -0700)
This will make it possible to fix to handle embedded NULs in the next
commits.

embed.fnc
embed.h
proto.h
toke.c

index ef43922..d87e109 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2684,11 +2684,11 @@ s       |void   |checkcomma     |NN const char *s|NN const char *name \
                                |NN const char *what
 s      |void   |force_ident    |NN const char *s|int kind
 s      |void   |force_ident_maybe_lex|char pit
-s      |void   |incline        |NN const char *s
+s      |void   |incline        |NN const char *s|NN const char *end
 s      |int    |intuit_method  |NN char *s|NULLOK SV *ioname|NULLOK CV *cv
-s      |int    |intuit_more    |NN char *s
+s      |int    |intuit_more    |NN char *s|NN char *e
 s      |I32    |lop            |I32 f|U8 x|NN char *s
-rs     |void   |missingterm    |NULLOK char *s
+rs     |void   |missingterm    |NULLOK char *s|const STRLEN len
 s      |void   |no_op          |NN const char *const what|NULLOK char *s
 s      |int    |pending_ident
 sR     |I32    |sublex_done
diff --git a/embed.h b/embed.h
index 34af92d..89e329a 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define force_version(a,b)     S_force_version(aTHX_ a,b)
 #define force_word(a,b,c,d)    S_force_word(aTHX_ a,b,c,d)
 #define get_and_check_backslash_N_name(a,b)    S_get_and_check_backslash_N_name(aTHX_ a,b)
-#define incline(a)             S_incline(aTHX_ a)
+#define incline(a,b)           S_incline(aTHX_ a,b)
 #define intuit_method(a,b,c)   S_intuit_method(aTHX_ a,b,c)
-#define intuit_more(a)         S_intuit_more(aTHX_ a)
+#define intuit_more(a,b)       S_intuit_more(aTHX_ a,b)
 #define lop(a,b,c)             S_lop(aTHX_ a,b,c)
-#define missingterm(a)         S_missingterm(aTHX_ a)
+#define missingterm(a,b)       S_missingterm(aTHX_ a,b)
 #define no_op(a,b)             S_no_op(aTHX_ a,b)
 #define parse_ident(a,b,c,d,e,f)       S_parse_ident(aTHX_ a,b,c,d,e,f)
 #define pending_ident()                S_pending_ident(aTHX)
diff --git a/proto.h b/proto.h
index 2547cec..fe3d94b 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5728,19 +5728,19 @@ STATIC SV*      S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* con
 #define PERL_ARGS_ASSERT_GET_AND_CHECK_BACKSLASH_N_NAME        \
        assert(s); assert(e)
 
-STATIC void    S_incline(pTHX_ const char *s);
+STATIC void    S_incline(pTHX_ const char *s, const char *end);
 #define PERL_ARGS_ASSERT_INCLINE       \
-       assert(s)
+       assert(s); assert(end)
 STATIC int     S_intuit_method(pTHX_ char *s, SV *ioname, CV *cv);
 #define PERL_ARGS_ASSERT_INTUIT_METHOD \
        assert(s)
-STATIC int     S_intuit_more(pTHX_ char *s);
+STATIC int     S_intuit_more(pTHX_ char *s, char *e);
 #define PERL_ARGS_ASSERT_INTUIT_MORE   \
-       assert(s)
+       assert(s); assert(e)
 STATIC I32     S_lop(pTHX_ I32 f, U8 x, char *s);
 #define PERL_ARGS_ASSERT_LOP   \
        assert(s)
-PERL_STATIC_NO_RET void        S_missingterm(pTHX_ char *s)
+PERL_STATIC_NO_RET void        S_missingterm(pTHX_ char *s, const STRLEN len)
                        __attribute__noreturn__;
 
 STATIC SV*     S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen, SV *sv, SV *pv, const char *type, STRLEN typelen);
diff --git a/toke.c b/toke.c
index 159e2ae..a60d16b 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -556,7 +556,7 @@ S_no_op(pTHX_ const char *const what, char *s)
  */
 
 STATIC void
-S_missingterm(pTHX_ char *s)
+S_missingterm(pTHX_ char *s, const STRLEN len)
 {
     char tmpbuf[UTF8_MAXBYTES + 1];
     char q;
@@ -1572,7 +1572,7 @@ Perl_lex_read_space(pTHX_ U32 flags)
                if (s == bufend)
                    need_incline = 1;
                else
-                   incline(s);
+                   incline(s, bufend);
            }
        } else if (isSPACE(c)) {
            s++;
@@ -1591,7 +1591,7 @@ Perl_lex_read_space(pTHX_ U32 flags)
            if (!got_more)
                break;
            if (can_incline && need_incline && PL_parser->rsfp) {
-               incline(s);
+               incline(s, bufend);
                need_incline = 0;
            }
        } else if (!c) {
@@ -1724,7 +1724,7 @@ Perl_validate_proto(pTHX_ SV *name, SV *proto, bool warn, bool curstash)
  */
 
 STATIC void
-S_incline(pTHX_ const char *s)
+S_incline(pTHX_ const char *s, const char *end)
 {
     const char *t;
     const char *n;
@@ -4142,7 +4142,7 @@ S_scan_const(pTHX_ char *start)
 /* This is the one truly awful dwimmer necessary to conflate C and sed. */
 
 STATIC int
-S_intuit_more(pTHX_ char *s)
+S_intuit_more(pTHX_ char *s, char *e)
 {
     PERL_ARGS_ASSERT_INTUIT_MORE;
 
@@ -4976,7 +4976,7 @@ Perl_yylex(pTHX)
        return yylex();
 
     case LEX_INTERPENDMAYBE:
-       if (intuit_more(PL_bufptr)) {
+       if (intuit_more(PL_bufptr, PL_bufend)) {
            PL_lex_state = LEX_INTERPNORMAL;    /* false alarm, more expr */
            break;
        }
@@ -5384,7 +5384,7 @@ Perl_yylex(pTHX)
                }
            }
            if (PL_rsfp || PL_parser->filtered)
-               incline(s);
+               incline(s, PL_bufend);
        } while (PL_parser->in_pod);
        PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
@@ -5609,7 +5609,7 @@ Perl_yylex(pTHX)
             && !PL_rsfp && !PL_parser->filtered) {
                /* handle eval qq[#line 1 "foo"\n ...] */
                CopLINE_dec(PL_curcop);
-               incline(s);
+               incline(s, PL_bufend);
            }
             d = s;
             while (d < PL_bufend && *d != '\n')
@@ -5622,7 +5622,7 @@ Perl_yylex(pTHX)
                 && PL_lex_inwhat == OP_SUBST && PL_lex_repl == PL_linestr
                 && SvEVALED(PL_lex_repl) && d[-1] == '}') s--;
             else
-                incline(s);
+                incline(s, PL_bufend);
            if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
                PL_lex_state = LEX_FORMLINE;
                force_next(FORMRBRACK);
@@ -5636,7 +5636,7 @@ Perl_yylex(pTHX)
                 {
                     s++;
                     if (s < PL_bufend)
-                        incline(s);
+                        incline(s, PL_bufend);
                 }
        }
        goto retry;
@@ -5837,7 +5837,8 @@ Perl_yylex(pTHX)
        if (!PL_tokenbuf[1]) {
            PREREF('%');
        }
-       if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
+        if (   (PL_expect != XREF || PL_oldoldbufptr == PL_last_lop)
+            && intuit_more(s, PL_bufend)) {
            if (*s == '[')
                PL_tokenbuf[0] = '@';
        }
@@ -6439,14 +6440,14 @@ Perl_yylex(pTHX)
                     d = PL_bufend;
                     while (s < d) {
                         if (*s++ == '\n') {
-                            incline(s);
+                            incline(s, PL_bufend);
                             if (strBEGINs(s,"=cut")) {
                                 s = strchr(s,'\n');
                                 if (s)
                                     s++;
                                 else
                                     s = d;
-                                incline(s);
+                                incline(s, PL_bufend);
                                 goto retry;
                             }
                         }
@@ -6670,8 +6671,8 @@ Perl_yylex(pTHX)
            if (PL_lex_state == LEX_NORMAL || PL_lex_brackets)
                s = skipspace(s);
 
-           if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop)
-               && intuit_more(s)) {
+           if (   (PL_expect != XREF || PL_oldoldbufptr == PL_last_lop)
+               && intuit_more(s, PL_bufend)) {
                if (*s == '[') {
                    PL_tokenbuf[0] = '@';
                    if (ckWARN(WARN_SYNTAX)) {
@@ -6799,7 +6800,9 @@ Perl_yylex(pTHX)
        }
        if (PL_lex_state == LEX_NORMAL)
            s = skipspace(s);
-       if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
+       if (   (PL_expect != XREF || PL_oldoldbufptr == PL_last_lop)
+            && intuit_more(s, PL_bufend))
+        {
            if (*s == '{')
                PL_tokenbuf[0] = '%';
 
@@ -6910,7 +6913,7 @@ Perl_yylex(pTHX)
     case '\'':
        s = scan_str(s,FALSE,FALSE,FALSE,NULL);
        if (!s)
-           missingterm(NULL);
+           missingterm(NULL, 0);
        COPLINE_SET_FROM_MULTI_END;
        DEBUG_T( { printbuf("### Saw string before %s\n", s); } );
        if (PL_expect == XOPERATOR) {
@@ -6932,7 +6935,7 @@ Perl_yylex(pTHX)
                no_op("String",s);
        }
        if (!s)
-           missingterm(NULL);
+           missingterm(NULL, 0);
        pl_yylval.ival = OP_CONST;
        /* FIXME. I think that this can be const if char *d is replaced by
           more localised variables.  */
@@ -6958,7 +6961,7 @@ Perl_yylex(pTHX)
        if (PL_expect == XOPERATOR)
            no_op("Backticks",s);
        if (!s)
-           missingterm(NULL);
+           missingterm(NULL, 0);
        pl_yylval.ival = OP_BACKTICK;
        TERM(sublex_start());
 
@@ -8334,7 +8337,7 @@ Perl_yylex(pTHX)
        case KEY_q:
            s = scan_str(s,FALSE,FALSE,FALSE,NULL);
            if (!s)
-               missingterm(NULL);
+               missingterm(NULL, 0);
            COPLINE_SET_FROM_MULTI_END;
            pl_yylval.ival = OP_CONST;
            TERM(sublex_start());
@@ -8346,7 +8349,7 @@ Perl_yylex(pTHX)
            OP *words = NULL;
            s = scan_str(s,FALSE,FALSE,FALSE,NULL);
            if (!s)
-               missingterm(NULL);
+               missingterm(NULL, 0);
            COPLINE_SET_FROM_MULTI_END;
            PL_expect = XOPERATOR;
            if (SvCUR(PL_lex_stuff)) {
@@ -8395,7 +8398,7 @@ Perl_yylex(pTHX)
        case KEY_qq:
            s = scan_str(s,FALSE,FALSE,FALSE,NULL);
            if (!s)
-               missingterm(NULL);
+               missingterm(NULL, 0);
            pl_yylval.ival = OP_STRINGIFY;
            if (SvIVX(PL_lex_stuff) == '\'')
                SvIV_set(PL_lex_stuff, 0);      /* qq'$foo' should interpolate */
@@ -8408,7 +8411,7 @@ Perl_yylex(pTHX)
        case KEY_qx:
            s = scan_str(s,FALSE,FALSE,FALSE,NULL);
            if (!s)
-               missingterm(NULL);
+               missingterm(NULL, 0);
            pl_yylval.ival = OP_BACKTICK;
            TERM(sublex_start());
 
@@ -9537,7 +9540,9 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
            *dest = '\0';
        }
     }
-    else if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets && !intuit_more(s))
+    else if (   PL_lex_state == LEX_INTERPNORMAL
+             && !PL_lex_brackets
+             && !intuit_more(s, PL_bufend))
        PL_lex_state = LEX_INTERPEND;
     return s;
 }
@@ -10286,7 +10291,7 @@ S_scan_heredoc(pTHX_ char *s)
   interminable:
     SvREFCNT_dec(tmpstr);
     CopLINE_set(PL_curcop, origline);
-    missingterm(PL_tokenbuf + 1);
+    missingterm(PL_tokenbuf + 1, sizeof(PL_tokenbuf) - 1);
 }
 
 /* scan_inputsymbol
@@ -11466,7 +11471,7 @@ S_scan_formline(pTHX_ char *s)
            if (!got_some)
                break;
        }
-       incline(s);
+       incline(s, PL_bufend);
     }
   enough:
     if (!SvCUR(stuff) || needargs)