X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/f791a21a201869623475139b9a596b9cff272a03..c30fc27b:/toke.c diff --git a/toke.c b/toke.c index 8fc205f..578fe14 100644 --- a/toke.c +++ b/toke.c @@ -1512,14 +1512,16 @@ chunk will not be discarded. =cut */ +#define LEX_NO_INCLINE 0x40000000 #define LEX_NO_NEXT_CHUNK 0x80000000 void Perl_lex_read_space(pTHX_ U32 flags) { char *s, *bufend; + const bool can_incline = !(flags & LEX_NO_INCLINE); bool need_incline = 0; - if (flags & ~(LEX_KEEP_PREVIOUS|LEX_NO_NEXT_CHUNK)) + if (flags & ~(LEX_KEEP_PREVIOUS|LEX_NO_NEXT_CHUNK|LEX_NO_INCLINE)) Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_read_space"); #ifdef PERL_MAD if (PL_skipwhite) { @@ -1539,11 +1541,13 @@ Perl_lex_read_space(pTHX_ U32 flags) } while (!(c == '\n' || (c == 0 && s == bufend))); } else if (c == '\n') { s++; - PL_parser->linestart = s; - if (s == bufend) - need_incline = 1; - else - incline(s); + if (can_incline) { + PL_parser->linestart = s; + if (s == bufend) + need_incline = 1; + else + incline(s); + } } else if (isSPACE(c)) { s++; } else if (c == 0 && s == bufend) { @@ -1555,14 +1559,14 @@ Perl_lex_read_space(pTHX_ U32 flags) if (flags & LEX_NO_NEXT_CHUNK) break; PL_parser->bufptr = s; - COPLINE_INC_WITH_HERELINES; + if (can_incline) COPLINE_INC_WITH_HERELINES; got_more = lex_next_chunk(flags); - CopLINE_dec(PL_curcop); + if (can_incline) CopLINE_dec(PL_curcop); s = PL_parser->bufptr; bufend = PL_parser->bufend; if (!got_more) break; - if (need_incline && PL_parser->rsfp) { + if (can_incline && need_incline && PL_parser->rsfp) { incline(s); need_incline = 0; } @@ -1661,6 +1665,10 @@ Perl_validate_proto(pTHX_ SV *name, SV *proto, bool warn) Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO), "Prototype after '%c' for %"SVf" : %s", greedy_proto, SVfARG(name), p); + if (in_brackets) + Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO), + "Missing ']' in prototype for %"SVf" : %s", + SVfARG(name), p); if (bad_proto) Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO), "Illegal character in prototype for %"SVf" : %s", @@ -1830,6 +1838,8 @@ S_incline(pTHX_ const char *s) CopLINE_set(PL_curcop, line_num); } +#define skipspace(s) skipspace_flags(s, 0) + #ifdef PERL_MAD /* skip space before PL_thistoken */ @@ -1919,7 +1929,7 @@ S_update_debugger_info(pTHX_ SV *orig_sv, const char *const buf, STRLEN len) if (av) { SV * const sv = newSV_type(SVt_PVMG); if (orig_sv) - sv_setsv(sv, orig_sv); + sv_setsv_flags(sv, orig_sv, 0); /* no cow */ else sv_setpvn(sv, buf, len); (void)SvIOK_on(sv); @@ -1935,12 +1945,12 @@ S_update_debugger_info(pTHX_ SV *orig_sv, const char *const buf, STRLEN len) */ STATIC char * -S_skipspace(pTHX_ char *s) +S_skipspace_flags(pTHX_ char *s, U32 flags) { #ifdef PERL_MAD char *start = s; #endif /* PERL_MAD */ - PERL_ARGS_ASSERT_SKIPSPACE; + PERL_ARGS_ASSERT_SKIPSPACE_FLAGS; #ifdef PERL_MAD if (PL_skipwhite) { sv_free(PL_skipwhite); @@ -1953,7 +1963,7 @@ S_skipspace(pTHX_ char *s) } else { STRLEN bufptr_pos = PL_bufptr - SvPVX(PL_linestr); PL_bufptr = s; - lex_read_space(LEX_KEEP_PREVIOUS | + lex_read_space(flags | LEX_KEEP_PREVIOUS | (PL_sublex_info.sub_inwhat || PL_lex_state == LEX_FORMLINE ? LEX_NO_NEXT_CHUNK : 0)); s = PL_bufptr; @@ -3275,12 +3285,12 @@ S_scan_const(pTHX_ char *start) * char, which will be done separately. * Stop on (?{..}) and friends */ - else if (*s == '(' && PL_lex_inpat && s[1] == '?') { + else if (*s == '(' && PL_lex_inpat && s[1] == '?' && !in_charclass) { if (s[2] == '#') { while (s+1 < send && *s != ')') *d++ = NATIVE_TO_NEED(has_utf8,*s++); } - else if (!PL_lex_casemods && !in_charclass && + else if (!PL_lex_casemods && ( s[2] == '{' /* This should match regcomp.c */ || (s[2] == '?' && s[3] == '{'))) { @@ -3289,7 +3299,7 @@ S_scan_const(pTHX_ char *start) } /* likewise skip #-initiated comments in //x patterns */ - else if (*s == '#' && PL_lex_inpat && + else if (*s == '#' && PL_lex_inpat && !in_charclass && ((PMOP*)PL_lex_inpat)->op_pmflags & RXf_PMf_EXTENDED) { while (s+1 < send && *s != '\n') *d++ = NATIVE_TO_NEED(has_utf8,*s++); @@ -5135,6 +5145,8 @@ Perl_yylex(pTHX) return yylex(); } + /* We really do *not* want PL_linestr ever becoming a COW. */ + assert (!SvIsCOW(PL_linestr)); s = PL_bufptr; PL_oldoldbufptr = PL_oldbufptr; PL_oldbufptr = s; @@ -5632,8 +5644,12 @@ Perl_yylex(pTHX) PL_bufend = s; */ } #else - *s = '\0'; - PL_bufend = s; + while (s < PL_bufend && *s != '\n') + s++; + if (s < PL_bufend) + s++; + else if (s > PL_bufend) /* Found by Ilya: feed random input to Perl. */ + Perl_croak(aTHX_ "panic: input overflow"); #endif } goto retry; @@ -6961,6 +6977,7 @@ Perl_yylex(pTHX) /* Is this a word before a => operator? */ if (*d == '=' && d[1] == '>') { + fat_arrow: CLINE; pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, @@ -7094,6 +7111,18 @@ Perl_yylex(pTHX) } } + if (tmp && tmp != KEY___DATA__ && tmp != KEY___END__ + && (!anydelim || *s != '#')) { + /* no override, and not s### either; skipspace is safe here + * check for => on following line */ + STRLEN bufoff = PL_bufptr - SvPVX(PL_linestr); + STRLEN soff = s - SvPVX(PL_linestr); + s = skipspace_flags(s, LEX_NO_INCLINE); + if (*s == '=' && s[1] == '>') goto fat_arrow; + PL_bufptr = SvPVX(PL_linestr) + bufoff; + s = SvPVX(PL_linestr) + soff; + } + reserved_word: switch (tmp) { @@ -7294,7 +7323,7 @@ Perl_yylex(pTHX) d = s + 1; while (SPACE_OR_TAB(*d)) d++; - if (*d == ')' && (sv = cv_const_sv(cv))) { + if (*d == ')' && (sv = cv_const_sv_or_av(cv))) { s = d + 1; goto its_constant; } @@ -7358,13 +7387,19 @@ Perl_yylex(pTHX) UTF8fARG(UTF, l, PL_tokenbuf)); } /* Check for a constant sub */ - if ((sv = cv_const_sv(cv))) { + if ((sv = cv_const_sv_or_av(cv))) { its_constant: op_free(rv2cv_op); SvREFCNT_dec(((SVOP*)pl_yylval.opval)->op_sv); ((SVOP*)pl_yylval.opval)->op_sv = SvREFCNT_inc_simple(sv); - pl_yylval.opval->op_private = OPpCONST_FOLDED; - pl_yylval.opval->op_flags |= OPf_SPECIAL; + if (SvTYPE(sv) == SVt_PVAV) + pl_yylval.opval = newUNOP(OP_RV2AV, OPf_PARENS, + pl_yylval.opval); + else { + pl_yylval.opval->op_private = OPpCONST_FOLDED; + pl_yylval.opval->op_folded = 1; + pl_yylval.opval->op_flags |= OPf_SPECIAL; + } TOKEN(WORD); } @@ -10142,8 +10177,11 @@ S_scan_heredoc(pTHX_ char *s) } CopLINE_set(PL_curcop, (line_t)PL_multi_start - 1); if (!SvCUR(PL_linestr) || PL_bufend[-1] != '\n') { - lex_grow_linestr(SvCUR(PL_linestr) + 2); + s = lex_grow_linestr(SvLEN(PL_linestr) + 3); + /* ^That should be enough to avoid this needing to grow: */ sv_catpvs(PL_linestr, "\n\0"); + assert(s == SvPVX(PL_linestr)); + PL_bufend = SvEND(PL_linestr); } s = PL_bufptr; #ifdef PERL_MAD @@ -10509,8 +10547,49 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims, int re_reparse, int offset = s - SvPVX_const(PL_linestr); const bool found = sv_cat_decode(sv, PL_encoding, PL_linestr, &offset, (char*)termstr, termlen); - const char * const ns = SvPVX_const(PL_linestr) + offset; - char * const svlast = SvEND(sv) - 1; + const char *ns; + char *svlast; + + if (SvIsCOW(PL_linestr)) { + STRLEN bufend_pos, bufptr_pos, oldbufptr_pos; + STRLEN oldoldbufptr_pos, linestart_pos, last_uni_pos; + STRLEN last_lop_pos, re_eval_start_pos, s_pos; + char *buf = SvPVX(PL_linestr); + bufend_pos = PL_parser->bufend - buf; + bufptr_pos = PL_parser->bufptr - buf; + oldbufptr_pos = PL_parser->oldbufptr - buf; + oldoldbufptr_pos = PL_parser->oldoldbufptr - buf; + linestart_pos = PL_parser->linestart - buf; + last_uni_pos = PL_parser->last_uni + ? PL_parser->last_uni - buf + : 0; + last_lop_pos = PL_parser->last_lop + ? PL_parser->last_lop - buf + : 0; + re_eval_start_pos = + PL_parser->lex_shared->re_eval_start ? + PL_parser->lex_shared->re_eval_start - buf : 0; + s_pos = s - buf; + + sv_force_normal(PL_linestr); + + buf = SvPVX(PL_linestr); + PL_parser->bufend = buf + bufend_pos; + PL_parser->bufptr = buf + bufptr_pos; + PL_parser->oldbufptr = buf + oldbufptr_pos; + PL_parser->oldoldbufptr = buf + oldoldbufptr_pos; + PL_parser->linestart = buf + linestart_pos; + if (PL_parser->last_uni) + PL_parser->last_uni = buf + last_uni_pos; + if (PL_parser->last_lop) + PL_parser->last_lop = buf + last_lop_pos; + if (PL_parser->lex_shared->re_eval_start) + PL_parser->lex_shared->re_eval_start = + buf + re_eval_start_pos; + s = buf + s_pos; + } + ns = SvPVX_const(PL_linestr) + offset; + svlast = SvEND(sv) - 1; for (; s < ns; s++) { if (*s == '\n' && !PL_rsfp && !PL_parser->filtered)