X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=988b2694a934fef9144f41f24fdb6044dbb5a1eb;hb=84c0b84e93593c55108ebfb4f82522eee2fd61e1;hp=bcd95925846839c120005e9c2cb2342a0f73a934;hpb=5db06880675667a071aa923bc110c33a81cc6d8a;p=p5sagit%2Fp5-mst-13.2.git diff --git a/toke.c b/toke.c index bcd9592..988b269 100644 --- a/toke.c +++ b/toke.c @@ -36,22 +36,8 @@ static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen); #endif #ifdef PERL_MAD -/* XXX these probably need to be made into PL vars */ -static I32 realtokenstart; -static I32 faketokens = 0; -static MADPROP *thismad; -static SV *thistoken; -static SV *thisopen; -static SV *thisstuff; -static SV *thisclose; -static SV *thiswhite; -static SV *nextwhite; -static SV *skipwhite; -static SV *endwhite; -static I32 curforce = -1; - # define CURMAD(slot,sv) if (PL_madskills) { curmad(slot,sv); sv = 0; } -# define NEXTVAL_NEXTTOKE PL_nexttoke[curforce].next_val +# define NEXTVAL_NEXTTOKE PL_nexttoke[PL_curforce].next_val #else # define CURMAD(slot,sv) # define NEXTVAL_NEXTTOKE PL_nextval[PL_nexttoke] @@ -312,7 +298,7 @@ static struct debug_tokens { { WHEN, TOKENTYPE_IVAL, "WHEN" }, { WHILE, TOKENTYPE_IVAL, "WHILE" }, { WORD, TOKENTYPE_OPVAL, "WORD" }, - { 0, TOKENTYPE_NONE, 0 } + { 0, TOKENTYPE_NONE, NULL } }; /* dump the returned token in rv, plus any optional arg in yylval */ @@ -443,7 +429,8 @@ S_no_op(pTHX_ const char *what, char *s) "\t(Missing semicolon on previous line?)\n"); else if (PL_oldoldbufptr && isIDFIRST_lazy_if(PL_oldoldbufptr,UTF)) { const char *t; - for (t = PL_oldoldbufptr; *t && (isALNUM_lazy_if(t,UTF) || *t == ':'); t++) ; + for (t = PL_oldoldbufptr; (isALNUM_lazy_if(t,UTF) || *t == ':'); t++) + NOOP; if (t < PL_bufptr && isSPACE(*t)) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "\t(Do you need to predeclare %.*s?)\n", @@ -461,7 +448,7 @@ S_no_op(pTHX_ const char *what, char *s) /* * S_missingterm * Complain about missing quote/regexp/heredoc terminator. - * If it's called with (char *)NULL then it cauterizes the line buffer. + * If it's called with NULL then it cauterizes the line buffer. * If we're in a delimited string and the delimiter is a control * character, it's reformatted into a two-char sequence like ^C. * This is fatal. @@ -507,13 +494,13 @@ S_missingterm(pTHX_ char *s) * Check whether the named feature is enabled. */ STATIC bool -S_feature_is_enabled(pTHX_ char *name, STRLEN namelen) +S_feature_is_enabled(pTHX_ const char *name, STRLEN namelen) { dVAR; HV * const hinthv = GvHV(PL_hintgv); char he_name[32] = "feature_"; (void) strncpy(&he_name[8], name, 24); - + return (hinthv && hv_exists(hinthv, he_name, 8 + namelen)); } @@ -614,17 +601,17 @@ Perl_lex_start(pTHX_ SV *line) SAVEI32(PL_lasttoke); } if (PL_madskills) { - SAVESPTR(thistoken); - SAVESPTR(thiswhite); - SAVESPTR(nextwhite); - SAVESPTR(thisopen); - SAVESPTR(thisclose); - SAVESPTR(thisstuff); - SAVEVPTR(thismad); - SAVEI32(realtokenstart); - SAVEI32(faketokens); - } - SAVEI32(curforce); + SAVESPTR(PL_thistoken); + SAVESPTR(PL_thiswhite); + SAVESPTR(PL_nextwhite); + SAVESPTR(PL_thisopen); + SAVESPTR(PL_thisclose); + SAVESPTR(PL_thisstuff); + SAVEVPTR(PL_thismad); + SAVEI32(PL_realtokenstart); + SAVEI32(PL_faketokens); + } + SAVEI32(PL_curforce); #else if (PL_lex_state == LEX_KNOWNEXT) { I32 toke = PL_nexttoke; @@ -725,7 +712,8 @@ S_incline(pTHX_ char *s) CopLINE_inc(PL_curcop); if (*s++ != '#') return; - while (SPACE_OR_TAB(*s)) s++; + while (SPACE_OR_TAB(*s)) + s++; if (strnEQ(s, "line", 4)) s += 4; else @@ -734,9 +722,11 @@ S_incline(pTHX_ char *s) s++; else return; - while (SPACE_OR_TAB(*s)) s++; + while (SPACE_OR_TAB(*s)) + s++; if (!isDIGIT(*s)) return; + n = s; while (isDIGIT(*s)) s++; @@ -747,7 +737,9 @@ S_incline(pTHX_ char *s) e = t + 1; } else { - for (t = s; !isSPACE(*t); t++) ; + t = s; + while (!isSPACE(*t)) + t++; e = t; } while (SPACE_OR_TAB(*e) || *e == '\r' || *e == '\f') @@ -803,7 +795,7 @@ S_incline(pTHX_ char *s) } #ifdef PERL_MAD -/* skip space before thistoken */ +/* skip space before PL_thistoken */ STATIC char * S_skipspace0(pTHX_ register char *s) @@ -811,40 +803,40 @@ S_skipspace0(pTHX_ register char *s) s = skipspace(s); if (!PL_madskills) return s; - if (skipwhite) { - if (!thiswhite) - thiswhite = newSVpvn("",0); - sv_catsv(thiswhite, skipwhite); - sv_free(skipwhite); - skipwhite = 0; - } - realtokenstart = s - SvPVX(PL_linestr); + if (PL_skipwhite) { + if (!PL_thiswhite) + PL_thiswhite = newSVpvn("",0); + sv_catsv(PL_thiswhite, PL_skipwhite); + sv_free(PL_skipwhite); + PL_skipwhite = 0; + } + PL_realtokenstart = s - SvPVX(PL_linestr); return s; } -/* skip space after thistoken */ +/* skip space after PL_thistoken */ STATIC char * S_skipspace1(pTHX_ register char *s) { - char *start = s; + const char *start = s; I32 startoff = start - SvPVX(PL_linestr); s = skipspace(s); if (!PL_madskills) return s; start = SvPVX(PL_linestr) + startoff; - if (!thistoken && realtokenstart >= 0) { - char *tstart = SvPVX(PL_linestr) + realtokenstart; - thistoken = newSVpvn(tstart, start - tstart); - } - realtokenstart = -1; - if (skipwhite) { - if (!nextwhite) - nextwhite = newSVpvn("",0); - sv_catsv(nextwhite, skipwhite); - sv_free(skipwhite); - skipwhite = 0; + if (!PL_thistoken && PL_realtokenstart >= 0) { + const char * const tstart = SvPVX(PL_linestr) + PL_realtokenstart; + PL_thistoken = newSVpvn(tstart, start - tstart); + } + PL_realtokenstart = -1; + if (PL_skipwhite) { + if (!PL_nextwhite) + PL_nextwhite = newSVpvn("",0); + sv_catsv(PL_nextwhite, PL_skipwhite); + sv_free(PL_skipwhite); + PL_skipwhite = 0; } return s; } @@ -852,25 +844,26 @@ S_skipspace1(pTHX_ register char *s) STATIC char * S_skipspace2(pTHX_ register char *s, SV **svp) { - char *start = s; - I32 bufptroff = PL_bufptr - SvPVX(PL_linestr); - I32 startoff = start - SvPVX(PL_linestr); + char *start; + const I32 bufptroff = PL_bufptr - SvPVX(PL_linestr); + const I32 startoff = s - SvPVX(PL_linestr); + s = skipspace(s); PL_bufptr = SvPVX(PL_linestr) + bufptroff; if (!PL_madskills || !svp) return s; start = SvPVX(PL_linestr) + startoff; - if (!thistoken && realtokenstart >= 0) { - char *tstart = SvPVX(PL_linestr) + realtokenstart; - thistoken = newSVpvn(tstart, start - tstart); - realtokenstart = -1; + if (!PL_thistoken && PL_realtokenstart >= 0) { + char * const tstart = SvPVX(PL_linestr) + PL_realtokenstart; + PL_thistoken = newSVpvn(tstart, start - tstart); + PL_realtokenstart = -1; } - if (skipwhite) { + if (PL_skipwhite) { if (!*svp) *svp = newSVpvn("",0); - sv_setsv(*svp, skipwhite); - sv_free(skipwhite); - skipwhite = 0; + sv_setsv(*svp, PL_skipwhite); + sv_free(PL_skipwhite); + PL_skipwhite = 0; } return s; @@ -891,9 +884,9 @@ S_skipspace(pTHX_ register char *s) int curoff; int startoff = s - SvPVX(PL_linestr); - if (skipwhite) { - sv_free(skipwhite); - skipwhite = 0; + if (PL_skipwhite) { + sv_free(PL_skipwhite); + PL_skipwhite = 0; } #endif @@ -950,9 +943,9 @@ S_skipspace(pTHX_ register char *s) { #ifdef PERL_MAD if (PL_madskills && curoff != startoff) { - if (!skipwhite) - skipwhite = newSVpvn("",0); - sv_catpvn(skipwhite, SvPVX(PL_linestr) + startoff, + if (!PL_skipwhite) + PL_skipwhite = newSVpvn("",0); + sv_catpvn(PL_skipwhite, SvPVX(PL_linestr) + startoff, curoff - startoff); } @@ -965,7 +958,7 @@ S_skipspace(pTHX_ register char *s) #endif /* end of file. Add on the -p or -n magic */ - /* XXX these shouldn't really be added here, can't set faketokens */ + /* XXX these shouldn't really be added here, can't set PL_faketokens */ if (PL_minus_p) { #ifdef PERL_MAD sv_catpv(PL_linestr, @@ -993,7 +986,11 @@ S_skipspace(pTHX_ register char *s) /* reset variables for next time we lex */ PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart - = SvPVX(PL_linestr); + = SvPVX(PL_linestr) +#ifdef PERL_MAD + + curoff +#endif + ; PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); PL_last_lop = PL_last_uni = NULL; @@ -1050,11 +1047,11 @@ S_skipspace(pTHX_ register char *s) #ifdef PERL_MAD done: if (PL_madskills) { - if (!skipwhite) - skipwhite = newSVpvn("",0); + if (!PL_skipwhite) + PL_skipwhite = newSVpvn("",0); curoff = s - SvPVX(PL_linestr); if (curoff - startoff) - sv_catpvn(skipwhite, SvPVX(PL_linestr) + startoff, + sv_catpvn(PL_skipwhite, SvPVX(PL_linestr) + startoff, curoff - startoff); } return s; @@ -1074,26 +1071,23 @@ STATIC void S_check_uni(pTHX) { dVAR; - char *s; - char *t; + const char *s; + const char *t; if (PL_oldoldbufptr != PL_last_uni) return; while (isSPACE(*PL_last_uni)) PL_last_uni++; - for (s = PL_last_uni; isALNUM_lazy_if(s,UTF) || *s == '-'; s++) ; + s = PL_last_uni; + while (isALNUM_lazy_if(s,UTF) || *s == '-') + s++; if ((t = strchr(s, '(')) && t < PL_bufptr) return; - /* XXX Things like this are just so nasty. We shouldn't be modifying - source code, even if we realquick set it back. */ if (ckWARN_d(WARN_AMBIGUOUS)){ - const char ch = *s; - *s = '\0'; Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), - "Warning: Use of \"%s\" without parentheses is ambiguous", - PL_last_uni); - *s = ch; + "Warning: Use of \"%.*s\" without parentheses is ambiguous", + (int)(s - PL_last_uni), PL_last_uni); } } @@ -1151,22 +1145,22 @@ S_start_force(pTHX_ int where) { int i; - if (where < 0) /* so people can duplicate start_force(curforce) */ + if (where < 0) /* so people can duplicate start_force(PL_curforce) */ where = PL_lasttoke; - assert(curforce < 0 || curforce == where); - if (curforce != where) { + assert(PL_curforce < 0 || PL_curforce == where); + if (PL_curforce != where) { for (i = PL_lasttoke; i > where; --i) { PL_nexttoke[i] = PL_nexttoke[i-1]; } PL_lasttoke++; } - if (curforce < 0) /* in case of duplicate start_force() */ + if (PL_curforce < 0) /* in case of duplicate start_force() */ Zero(&PL_nexttoke[where], 1, NEXTTOKE); - curforce = where; - if (nextwhite) { + PL_curforce = where; + if (PL_nextwhite) { if (PL_madskills) curmad('^', newSVpvn("",0)); - CURMAD('_', nextwhite); + CURMAD('_', PL_nextwhite); } } @@ -1177,12 +1171,12 @@ S_curmad(pTHX_ char slot, SV *sv) if (!sv) return; - if (curforce < 0) - where = &thismad; + if (PL_curforce < 0) + where = &PL_thismad; else - where = &PL_nexttoke[curforce].next_mad; + where = &PL_nexttoke[PL_curforce].next_mad; - if (faketokens) + if (PL_faketokens) sv_setpvn(sv, "", 0); else { if (!IN_BYTES) { @@ -1204,8 +1198,8 @@ S_curmad(pTHX_ char slot, SV *sv) addmad(newMADsv(slot, sv), where, 0); } #else -# define start_force(where) -# define curmad(slot, sv) +# define start_force(where) NOOP +# define curmad(slot, sv) NOOP #endif /* @@ -1222,14 +1216,14 @@ S_force_next(pTHX_ I32 type) { dVAR; #ifdef PERL_MAD - if (curforce < 0) + if (PL_curforce < 0) start_force(PL_lasttoke); - PL_nexttoke[curforce].next_type = type; + PL_nexttoke[PL_curforce].next_type = type; if (PL_lex_state != LEX_KNOWNEXT) PL_lex_defer = PL_lex_state; PL_lex_state = LEX_KNOWNEXT; PL_lex_expect = PL_expect; - curforce = -1; + PL_curforce = -1; #else PL_nexttype[PL_nexttoke] = type; PL_nexttoke++; @@ -1283,7 +1277,7 @@ S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len); if (check_keyword && keyword(PL_tokenbuf, len)) return start; - start_force(curforce); + start_force(PL_curforce); if (PL_madskills) curmad('X', newSVpvn(start,s-start)); if (token == METHOD) { @@ -1316,10 +1310,10 @@ STATIC void S_force_ident(pTHX_ register const char *s, int kind) { dVAR; - if (s && *s) { + if (*s) { const STRLEN len = strlen(s); OP* const o = (OP*)newSVOP(OP_CONST, 0, newSVpvn(s, len)); - start_force(curforce); + start_force(PL_curforce); NEXTVAL_NEXTTOKE.opval = o; force_next(WORD); if (kind) { @@ -1392,7 +1386,7 @@ S_force_version(pTHX_ char *s, int guessing) d++; #ifdef PERL_MAD if (PL_madskills) { - start_force(curforce); + start_force(PL_curforce); curmad('X', newSVpvn(s,d-s)); } #endif @@ -1410,8 +1404,8 @@ S_force_version(pTHX_ char *s, int guessing) else if (guessing) { #ifdef PERL_MAD if (PL_madskills) { - sv_free(nextwhite); /* let next token collect whitespace */ - nextwhite = 0; + sv_free(PL_nextwhite); /* let next token collect whitespace */ + PL_nextwhite = 0; s = SvPVX(PL_linestr) + startoff; } #endif @@ -1421,13 +1415,13 @@ S_force_version(pTHX_ char *s, int guessing) #ifdef PERL_MAD if (PL_madskills && !version) { - sv_free(nextwhite); /* let next token collect whitespace */ - nextwhite = 0; + sv_free(PL_nextwhite); /* let next token collect whitespace */ + PL_nextwhite = 0; s = SvPVX(PL_linestr) + startoff; } #endif /* NOTE: The parser sees the package name and the VERSION swapped */ - start_force(curforce); + start_force(PL_curforce); NEXTVAL_NEXTTOKE.opval = version; force_next(WORD); @@ -1678,16 +1672,16 @@ S_sublex_done(pTHX) else { #ifdef PERL_MAD if (PL_madskills) { - if (thiswhite) { - if (!endwhite) - endwhite = newSVpvn("",0); - sv_catsv(endwhite, thiswhite); - thiswhite = 0; - } - if (thistoken) - sv_setpvn(thistoken,"",0); + if (PL_thiswhite) { + if (!PL_endwhite) + PL_endwhite = newSVpvn("",0); + sv_catsv(PL_endwhite, PL_thiswhite); + PL_thiswhite = 0; + } + if (PL_thistoken) + sv_setpvn(PL_thistoken,"",0); else - realtokenstart = -1; + PL_realtokenstart = -1; } #endif LEAVE; @@ -1789,7 +1783,7 @@ S_scan_const(pTHX_ char *start) UV literal_endpoint = 0; #endif - const char *leaveit = /* set of acceptably-backslashed characters */ + const char * const leaveit = /* set of acceptably-backslashed characters */ PL_lex_inpat ? "\\.^$@AGZdDwWsSbBpPXC+*?|()-nrtfeaxz0123456789[{]} \t\n\r\f\v#" : ""; @@ -2486,7 +2480,7 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv) } } } else - gv = 0; + gv = NULL; } s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len); /* start is the beginning of the possible filehandle/object, @@ -2529,7 +2523,7 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv) if ((PL_bufend - s) >= 2 && *s == '=' && *(s+1) == '>') return 0; /* no assumptions -- "=>" quotes bearword */ bare_package: - start_force(curforce); + start_force(PL_curforce); NEXTVAL_NEXTTOKE.opval = (OP*)newSVOP(OP_CONST, 0, newSVpvn(tmpbuf,len)); NEXTVAL_NEXTTOKE.opval->op_private = OPpCONST_BARE; @@ -2602,7 +2596,8 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) IoANY(datasv) = FPTR2DPTR(void *, funcp); /* stash funcp into spare field */ IoFLAGS(datasv) |= IOf_FAKE_DIRP; DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n", - IoANY(datasv), SvPV_nolen(datasv))); + FPTR2DPTR(void *, IoANY(datasv)), + SvPV_nolen(datasv))); av_unshift(PL_rsfp_filters, 1); av_store(PL_rsfp_filters, 0, datasv) ; return(datasv); @@ -2617,7 +2612,8 @@ Perl_filter_del(pTHX_ filter_t funcp) SV *datasv; #ifdef DEBUGGING - DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", FPTR2DPTR(XPVIO *, funcp))); + DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", + FPTR2DPTR(void*, funcp))); #endif if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0) return; @@ -2643,6 +2639,17 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) dVAR; filter_t funcp; SV *datasv = NULL; + /* This API is bad. It should have been using unsigned int for maxlen. + Not sure if we want to change the API, but if not we should sanity + check the value here. */ + const unsigned int correct_length + = maxlen < 0 ? +#ifdef PERL_MICRO + 0x7FFFFFFF +#else + INT_MAX +#endif + : maxlen; if (!PL_rsfp_filters) return -1; @@ -2651,14 +2658,15 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) /* Note that we append to the line. This is handy. */ DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_read %d: from rsfp\n", idx)); - if (maxlen) { + if (correct_length) { /* Want a block */ int len ; const int old_len = SvCUR(buf_sv); /* ensure buf_sv is large enough */ - SvGROW(buf_sv, (STRLEN)(old_len + maxlen)) ; - if ((len = PerlIO_read(PL_rsfp, SvPVX(buf_sv) + old_len, maxlen)) <= 0){ + SvGROW(buf_sv, (STRLEN)(old_len + correct_length)) ; + if ((len = PerlIO_read(PL_rsfp, SvPVX(buf_sv) + old_len, + correct_length)) <= 0) { if (PerlIO_error(PL_rsfp)) return -1; /* error */ else @@ -2681,17 +2689,17 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_read %d: skipped (filter deleted)\n", idx)); - return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */ + return FILTER_READ(idx+1, buf_sv, correct_length); /* recurse */ } /* Get function pointer hidden within datasv */ funcp = DPTR2FPTR(filter_t, IoANY(datasv)); DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_read %d: via function %p (%s)\n", - idx, datasv, SvPV_nolen_const(datasv))); + idx, (void*)datasv, SvPV_nolen_const(datasv))); /* Call function. The function is expected to */ /* call "FILTER_READ(idx+1, buf_sv)" first. */ /* Return: <0:error, =0:eof, >0:not eof */ - return (*funcp)(aTHX_ idx, buf_sv, maxlen); + return (*funcp)(aTHX_ idx, buf_sv, correct_length); } STATIC char * @@ -2732,11 +2740,11 @@ S_find_in_my_stash(pTHX_ const char *pkgname, I32 len) } /* use constant CLASS => 'MyClass' */ - if ((gv = gv_fetchpvn_flags(pkgname, len, 0, SVt_PVCV))) { - SV *sv; - if (GvCV(gv) && (sv = cv_const_sv(GvCV(gv)))) { + gv = gv_fetchpvn_flags(pkgname, len, 0, SVt_PVCV); + if (gv && GvCV(gv)) { + SV * const sv = cv_const_sv(GvCV(gv)); + if (sv) pkgname = SvPV_nolen_const(sv); - } } return gv_stashpv(pkgname, FALSE); @@ -2756,83 +2764,83 @@ Perl_madlex(pTHX) int optype; char *s = PL_bufptr; - /* make sure thiswhite is initialized */ - thiswhite = 0; - thismad = 0; + /* make sure PL_thiswhite is initialized */ + PL_thiswhite = 0; + PL_thismad = 0; - /* just do what yylex would do on pending identifier; leave thiswhite alone */ + /* just do what yylex would do on pending identifier; leave PL_thiswhite alone */ if (PL_pending_ident) return S_pending_ident(aTHX); /* previous token ate up our whitespace? */ - if (!PL_lasttoke && nextwhite) { - thiswhite = nextwhite; - nextwhite = 0; + if (!PL_lasttoke && PL_nextwhite) { + PL_thiswhite = PL_nextwhite; + PL_nextwhite = 0; } /* isolate the token, and figure out where it is without whitespace */ - realtokenstart = -1; - thistoken = 0; + PL_realtokenstart = -1; + PL_thistoken = 0; optype = yylex(); s = PL_bufptr; - assert(curforce < 0); + assert(PL_curforce < 0); - if (!thismad || thismad->mad_key == '^') { /* not forced already? */ - if (!thistoken) { - if (realtokenstart < 0 || !CopLINE(PL_curcop)) - thistoken = newSVpvn("",0); + if (!PL_thismad || PL_thismad->mad_key == '^') { /* not forced already? */ + if (!PL_thistoken) { + if (PL_realtokenstart < 0 || !CopLINE(PL_curcop)) + PL_thistoken = newSVpvn("",0); else { - char *tstart = SvPVX(PL_linestr) + realtokenstart; - thistoken = newSVpvn(tstart, s - tstart); + char * const tstart = SvPVX(PL_linestr) + PL_realtokenstart; + PL_thistoken = newSVpvn(tstart, s - tstart); } } - if (thismad) /* install head */ - CURMAD('X', thistoken); + if (PL_thismad) /* install head */ + CURMAD('X', PL_thistoken); } /* last whitespace of a sublex? */ - if (optype == ')' && endwhite) { - CURMAD('X', endwhite); + if (optype == ')' && PL_endwhite) { + CURMAD('X', PL_endwhite); } - if (!thismad) { + if (!PL_thismad) { /* if no whitespace and we're at EOF, bail. Otherwise fake EOF below. */ - if (!thiswhite && !endwhite && !optype) { - sv_free(thistoken); - thistoken = 0; + if (!PL_thiswhite && !PL_endwhite && !optype) { + sv_free(PL_thistoken); + PL_thistoken = 0; return 0; } /* put off final whitespace till peg */ if (optype == ';' && !PL_rsfp) { - nextwhite = thiswhite; - thiswhite = 0; + PL_nextwhite = PL_thiswhite; + PL_thiswhite = 0; } - else if (thisopen) { - CURMAD('q', thisopen); - if (thistoken) - sv_free(thistoken); - thistoken = 0; + else if (PL_thisopen) { + CURMAD('q', PL_thisopen); + if (PL_thistoken) + sv_free(PL_thistoken); + PL_thistoken = 0; } else { /* Store actual token text as madprop X */ - CURMAD('X', thistoken); + CURMAD('X', PL_thistoken); } - if (thiswhite) { + if (PL_thiswhite) { /* add preceding whitespace as madprop _ */ - CURMAD('_', thiswhite); + CURMAD('_', PL_thiswhite); } - if (thisstuff) { + if (PL_thisstuff) { /* add quoted material as madprop = */ - CURMAD('=', thisstuff); + CURMAD('=', PL_thisstuff); } - if (thisclose) { + if (PL_thisclose) { /* add terminating quote as madprop Q */ - CURMAD('Q', thisclose); + CURMAD('Q', PL_thisclose); } } @@ -2851,22 +2859,22 @@ Perl_madlex(pTHX) case UNIOPSUB: case LSTOPSUB: if (yylval.opval) - append_madprops(thismad, yylval.opval, 0); - thismad = 0; + append_madprops(PL_thismad, yylval.opval, 0); + PL_thismad = 0; return optype; /* fake EOF */ case 0: optype = PEG; - if (endwhite) { - addmad(newMADsv('p', endwhite), &thismad, 0); - endwhite = 0; + if (PL_endwhite) { + addmad(newMADsv('p', PL_endwhite), &PL_thismad, 0); + PL_endwhite = 0; } break; case ']': case '}': - if (faketokens) + if (PL_faketokens) break; /* remember any fake bracket that lexer is about to discard */ if (PL_lex_brackets == 1 && @@ -2876,9 +2884,9 @@ Perl_madlex(pTHX) while (s < PL_bufend && (*s == ' ' || *s == '\t')) s++; if (*s == '}') { - thiswhite = newSVpvn(PL_bufptr, ++s - PL_bufptr); - addmad(newMADsv('#', thiswhite), &thismad, 0); - thiswhite = 0; + PL_thiswhite = newSVpvn(PL_bufptr, ++s - PL_bufptr); + addmad(newMADsv('#', PL_thiswhite), &PL_thismad, 0); + PL_thiswhite = 0; PL_bufptr = s - 1; break; /* don't bother looking for trailing comment */ } @@ -2891,7 +2899,7 @@ Perl_madlex(pTHX) /* attach a trailing comment to its statement instead of next token */ case ';': - if (faketokens) + if (PL_faketokens) break; if (PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == optype) { s = PL_bufptr; @@ -2902,9 +2910,9 @@ Perl_madlex(pTHX) s++; if (s < PL_bufend) s++; - thiswhite = newSVpvn(PL_bufptr, s - PL_bufptr); - addmad(newMADsv('#', thiswhite), &thismad, 0); - thiswhite = 0; + PL_thiswhite = newSVpvn(PL_bufptr, s - PL_bufptr); + addmad(newMADsv('#', PL_thiswhite), &PL_thismad, 0); + PL_thiswhite = 0; PL_bufptr = s; } } @@ -2921,8 +2929,8 @@ Perl_madlex(pTHX) } /* Create new token struct. Note: opvals return early above. */ - yylval.tkval = newTOKEN(optype, yylval, thismad); - thismad = 0; + yylval.tkval = newTOKEN(optype, yylval, PL_thismad); + PL_thismad = 0; return optype; } #endif @@ -2937,7 +2945,7 @@ S_tokenize_use(pTHX_ int is_use, char *s) { if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) { s = force_version(s, TRUE); if (*s == ';' || (s = SKIPSPACE1(s), *s == ';')) { - start_force(curforce); + start_force(PL_curforce); NEXTVAL_NEXTTOKE.opval = NULL; force_next(WORD); } @@ -3026,13 +3034,13 @@ Perl_yylex(pTHX) PL_lasttoke--; yylval = PL_nexttoke[PL_lasttoke].next_val; if (PL_madskills) { - thismad = PL_nexttoke[PL_lasttoke].next_mad; + PL_thismad = PL_nexttoke[PL_lasttoke].next_mad; PL_nexttoke[PL_lasttoke].next_mad = 0; - if (thismad && thismad->mad_key == '_') { - thiswhite = (SV*)thismad->mad_val; - thismad->mad_val = 0; - mad_free(thismad); - thismad = 0; + if (PL_thismad && PL_thismad->mad_key == '_') { + PL_thiswhite = (SV*)PL_thismad->mad_val; + PL_thismad->mad_val = 0; + mad_free(PL_thismad); + PL_thismad = 0; } } if (!PL_lasttoke) { @@ -3079,7 +3087,7 @@ Perl_yylex(pTHX) PL_lex_state = LEX_INTERPCONCAT; #ifdef PERL_MAD if (PL_madskills) - thistoken = newSVpvn("\\E",2); + PL_thistoken = newSVpvn("\\E",2); #endif } return REPORT(')'); @@ -3087,9 +3095,9 @@ Perl_yylex(pTHX) #ifdef PERL_MAD while (PL_bufptr != PL_bufend && PL_bufptr[0] == '\\' && PL_bufptr[1] == 'E') { - if (!thiswhite) - thiswhite = newSVpvn("",0); - sv_catpvn(thiswhite, PL_bufptr, 2); + if (!PL_thiswhite) + PL_thiswhite = newSVpvn("",0); + sv_catpvn(PL_thiswhite, PL_bufptr, 2); PL_bufptr += 2; } #else @@ -3104,12 +3112,12 @@ Perl_yylex(pTHX) "### Saw case modifier\n"); }); s = PL_bufptr + 1; if (s[1] == '\\' && s[2] == 'E') { - PL_bufptr = s + 3; #ifdef PERL_MAD - if (!thiswhite) - thiswhite = newSVpvn("",0); - sv_catpvn(thiswhite, PL_bufptr, 4); + if (!PL_thiswhite) + PL_thiswhite = newSVpvn("",0); + sv_catpvn(PL_thiswhite, PL_bufptr, 4); #endif + PL_bufptr = s + 3; PL_lex_state = LEX_INTERPCONCAT; return yylex(); } @@ -3128,10 +3136,10 @@ Perl_yylex(pTHX) PL_lex_casestack[PL_lex_casemods++] = *s; PL_lex_casestack[PL_lex_casemods] = '\0'; PL_lex_state = LEX_INTERPCONCAT; - start_force(curforce); + start_force(PL_curforce); NEXTVAL_NEXTTOKE.ival = 0; force_next('('); - start_force(curforce); + start_force(PL_curforce); if (*s == 'l') NEXTVAL_NEXTTOKE.ival = OP_LCFIRST; else if (*s == 'u') @@ -3145,7 +3153,7 @@ Perl_yylex(pTHX) else Perl_croak(aTHX_ "panic: yylex"); if (PL_madskills) { - SV* tmpsv = newSVpvn("",0); + SV* const tmpsv = newSVpvn("",0); Perl_sv_catpvf(aTHX_ tmpsv, "\\%c", *s); curmad('_', tmpsv); } @@ -3157,9 +3165,9 @@ Perl_yylex(pTHX) PL_lex_starts = 0; #ifdef PERL_MAD if (PL_madskills) { - if (thistoken) - sv_free(thistoken); - thistoken = newSVpvn("",0); + if (PL_thistoken) + sv_free(PL_thistoken); + PL_thistoken = newSVpvn("",0); } #endif /* commas only at base level: /$a\Ub$c/ => ($a,uc(b.$c)) */ @@ -3184,18 +3192,18 @@ Perl_yylex(pTHX) PL_lex_dojoin = (*PL_bufptr == '@'); PL_lex_state = LEX_INTERPNORMAL; if (PL_lex_dojoin) { - start_force(curforce); + start_force(PL_curforce); NEXTVAL_NEXTTOKE.ival = 0; force_next(','); - start_force(curforce); + start_force(PL_curforce); force_ident("\"", '$'); - start_force(curforce); + start_force(PL_curforce); NEXTVAL_NEXTTOKE.ival = 0; force_next('$'); - start_force(curforce); + start_force(PL_curforce); NEXTVAL_NEXTTOKE.ival = 0; force_next('('); - start_force(curforce); + start_force(PL_curforce); NEXTVAL_NEXTTOKE.ival = OP_JOIN; /* emulate join($", ...) */ force_next(FUNC); } @@ -3203,9 +3211,9 @@ Perl_yylex(pTHX) s = PL_bufptr; #ifdef PERL_MAD if (PL_madskills) { - if (thistoken) - sv_free(thistoken); - thistoken = newSVpvn("",0); + if (PL_thistoken) + sv_free(PL_thistoken); + PL_thistoken = newSVpvn("",0); } #endif /* commas only at base level: /$a\Ub$c/ => ($a,uc(b.$c)) */ @@ -3229,9 +3237,9 @@ Perl_yylex(pTHX) PL_lex_state = LEX_INTERPCONCAT; #ifdef PERL_MAD if (PL_madskills) { - if (thistoken) - sv_free(thistoken); - thistoken = newSVpvn("",0); + if (PL_thistoken) + sv_free(PL_thistoken); + PL_thistoken = newSVpvn("",0); } #endif return REPORT(')'); @@ -3270,7 +3278,7 @@ Perl_yylex(pTHX) } if (s != PL_bufptr) { - start_force(curforce); + start_force(PL_curforce); if (PL_madskills) { curmad('X', newSVpvn(PL_bufptr,s-PL_bufptr)); } @@ -3280,9 +3288,9 @@ Perl_yylex(pTHX) if (PL_lex_starts++) { #ifdef PERL_MAD if (PL_madskills) { - if (thistoken) - sv_free(thistoken); - thistoken = newSVpvn("",0); + if (PL_thistoken) + sv_free(PL_thistoken); + PL_thistoken = newSVpvn("",0); } #endif /* commas only at base level: /$a\Ub$c/ => ($a,uc(b.$c)) */ @@ -3312,11 +3320,11 @@ Perl_yylex(pTHX) retry: #ifdef PERL_MAD - if (thistoken) { - sv_free(thistoken); - thistoken = 0; + if (PL_thistoken) { + sv_free(PL_thistoken); + PL_thistoken = 0; } - realtokenstart = s - SvPVX(PL_linestr); /* assume but undo on ws */ + PL_realtokenstart = s - SvPVX(PL_linestr); /* assume but undo on ws */ #endif switch (*s) { default: @@ -3329,7 +3337,7 @@ Perl_yylex(pTHX) case 0: #ifdef PERL_MAD if (PL_madskills) - faketokens = 0; + PL_faketokens = 0; #endif if (!PL_rsfp) { PL_last_uni = 0; @@ -3352,7 +3360,7 @@ Perl_yylex(pTHX) PL_preambled = TRUE; #ifdef PERL_MAD if (PL_madskills) - faketokens = 1; + PL_faketokens = 1; #endif sv_setpv(PL_linestr,incl_perldb()); if (SvCUR(PL_linestr)) @@ -3420,7 +3428,7 @@ Perl_yylex(pTHX) if ((s = filter_gets(PL_linestr, PL_rsfp, 0)) == NULL) { fake_eof: #ifdef PERL_MAD - realtokenstart = -1; + PL_realtokenstart = -1; #endif if (PL_rsfp) { if (PL_preprocess && !PL_in_eval) @@ -3435,7 +3443,7 @@ Perl_yylex(pTHX) if (!PL_in_eval && (PL_minus_n || PL_minus_p)) { #ifdef PERL_MAD if (PL_madskills) - faketokens = 1; + PL_faketokens = 1; #endif sv_setpv(PL_linestr,PL_minus_p ? ";}continue{print;}" : ";}"); @@ -3489,7 +3497,7 @@ Perl_yylex(pTHX) /* Incest with pod. */ #ifdef PERL_MAD if (PL_madskills) - sv_catsv(thiswhite, PL_linestr); + sv_catsv(PL_thiswhite, PL_linestr); #endif if (*s == '=' && strnEQ(s, "=cut", 4)) { sv_setpvn(PL_linestr, "", 0); @@ -3520,7 +3528,7 @@ Perl_yylex(pTHX) s++; #ifdef PERL_MAD if (PL_madskills) - thiswhite = newSVpvn(PL_linestart, s - PL_linestart); + PL_thiswhite = newSVpvn(PL_linestart, s - PL_linestart); #endif d = NULL; if (!PL_in_eval) { @@ -3652,8 +3660,10 @@ Perl_yylex(pTHX) } #endif if (d) { - while (*d && !isSPACE(*d)) d++; - while (SPACE_OR_TAB(*d)) d++; + while (*d && !isSPACE(*d)) + d++; + while (SPACE_OR_TAB(*d)) + d++; if (*d++ == '-') { const bool switches_done = PL_doswitches; @@ -3664,7 +3674,8 @@ Perl_yylex(pTHX) do { if (*d == 'M' || *d == 'm' || *d == 'C') { const char * const m = d; - while (*d && !isSPACE(*d)) d++; + while (*d && !isSPACE(*d)) + d++; Perl_croak(aTHX_ "Too late for \"-%.*s\" option", (int)(d - m), m); } @@ -3713,7 +3724,7 @@ Perl_yylex(pTHX) case '\312': #endif #ifdef PERL_MAD - realtokenstart = -1; + PL_realtokenstart = -1; s = SKIPSPACE0(s); #else s++; @@ -3722,9 +3733,9 @@ Perl_yylex(pTHX) case '#': case '\n': #ifdef PERL_MAD - realtokenstart = -1; + PL_realtokenstart = -1; if (PL_madskills) - faketokens = 0; + PL_faketokens = 0; #endif if (PL_lex_state != LEX_NORMAL || (PL_in_eval && !PL_rsfp)) { if (*s == '#' && s == PL_linestart && PL_in_eval && !PL_rsfp) { @@ -3747,7 +3758,7 @@ Perl_yylex(pTHX) Perl_croak(aTHX_ "panic: input overflow"); #ifdef PERL_MAD if (PL_madskills) - thiswhite = newSVpvn(s, d - s); + PL_thiswhite = newSVpvn(s, d - s); #endif s = d; incline(s); @@ -3762,7 +3773,7 @@ Perl_yylex(pTHX) #ifdef PERL_MAD if (PL_madskills && CopLINE(PL_curcop) >= 1 && !PL_lex_formbrack) { if (CopLINE(PL_curcop) == 1 && s[0] == '#' && s[1] == '!') { - faketokens = 0; + PL_faketokens = 0; s = SKIPSPACE0(s); TOKEN(PEG); /* make sure any #! line is accessible */ } @@ -3778,13 +3789,13 @@ Perl_yylex(pTHX) else if (d > PL_bufend) /* Found by Ilya: feed random input to Perl. */ Perl_croak(aTHX_ "panic: input overflow"); if (PL_madskills && CopLINE(PL_curcop) >= 1) { - if (!thiswhite) - thiswhite = newSVpvn("",0); + if (!PL_thiswhite) + PL_thiswhite = newSVpvn("",0); if (CopLINE(PL_curcop) == 1) { - sv_setpvn(thiswhite, "", 0); - faketokens = 0; + sv_setpvn(PL_thiswhite, "", 0); + PL_faketokens = 0; } - sv_catpvn(thiswhite, s, d - s); + sv_catpvn(PL_thiswhite, s, d - s); } s = d; /* } @@ -3811,9 +3822,7 @@ Perl_yylex(pTHX) if (strnEQ(s,"=>",2)) { s = force_word(PL_bufptr,WORD,FALSE,FALSE,FALSE); - DEBUG_T( { S_printbuf(aTHX_ - "### Saw unary minus before =>, forcing word %s\n", s); - } ); + DEBUG_T( { printbuf("### Saw unary minus before =>, forcing word %s\n", s); } ); OPERATOR('-'); /* unary minus */ } PL_last_uni = PL_oldbufptr; @@ -3997,6 +4006,7 @@ Perl_yylex(pTHX) attrs = NULL; while (isIDFIRST_lazy_if(s,UTF)) { I32 tmp; + SV *sv; d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len); if (isLOWER(*s) && (tmp = keyword(PL_tokenbuf, len))) { if (tmp < 0) tmp = -tmp; @@ -4014,6 +4024,7 @@ Perl_yylex(pTHX) break; } } + sv = newSVpvn(s, len); if (*d == '(') { d = scan_str(d,TRUE,TRUE); if (!d) { @@ -4024,11 +4035,11 @@ Perl_yylex(pTHX) yyerror("Unterminated attribute parameter in attribute list"); if (attrs) op_free(attrs); + sv_free(sv); return REPORT(0); /* EOF indicator */ } } if (PL_lex_stuff) { - SV *sv = newSVpvn(s, len); sv_catsv(sv, PL_lex_stuff); attrs = append_elem(OP_LIST, attrs, newSVOP(OP_CONST, 0, sv)); @@ -4036,27 +4047,38 @@ Perl_yylex(pTHX) PL_lex_stuff = NULL; } else { - if (len == 6 && strnEQ(s, "unique", len)) { - if (PL_in_my == KEY_our) + if (len == 6 && strnEQ(SvPVX(sv), "unique", len)) { + sv_free(sv); + if (PL_in_my == KEY_our) { #ifdef USE_ITHREADS GvUNIQUE_on(cGVOPx_gv(yylval.opval)); #else - /*EMPTY*/; /* skip to avoid loading attributes.pm */ + /* skip to avoid loading attributes.pm */ #endif + deprecate(":unique"); + } else Perl_croak(aTHX_ "The 'unique' attribute may only be applied to 'our' variables"); } /* NOTE: any CV attrs applied here need to be part of the CVf_BUILTIN_ATTRS define in cv.h! */ - else if (!PL_in_my && len == 6 && strnEQ(s, "lvalue", len)) + else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "lvalue", len)) { + sv_free(sv); CvLVALUE_on(PL_compcv); - else if (!PL_in_my && len == 6 && strnEQ(s, "locked", len)) + } + else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "locked", len)) { + sv_free(sv); CvLOCKED_on(PL_compcv); - else if (!PL_in_my && len == 6 && strnEQ(s, "method", len)) + } + else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "method", len)) { + sv_free(sv); CvMETHOD_on(PL_compcv); - else if (!PL_in_my && len == 9 && strnEQ(s, "assertion", len)) + } + else if (!PL_in_my && len == 9 && strnEQ(SvPVX(sv), "assertion", len)) { + sv_free(sv); CvASSERTION_on(PL_compcv); + } /* After we've set the flags, it could be argued that we don't need to do the attributes.pm-based setting process, and shouldn't bother appending recognized @@ -4070,7 +4092,7 @@ Perl_yylex(pTHX) else attrs = append_elem(OP_LIST, attrs, newSVOP(OP_CONST, 0, - newSVpvn(s, len))); + sv)); } s = PEEKSPACE(d); if (*s == ':' && s[1] != ':') @@ -4106,14 +4128,14 @@ Perl_yylex(pTHX) } got_attrs: if (attrs) { - start_force(curforce); + start_force(PL_curforce); NEXTVAL_NEXTTOKE.opval = attrs; - CURMAD('_', nextwhite); - force_next(THING); + CURMAD('_', PL_nextwhite); + force_next(THING); } #ifdef PERL_MAD if (PL_madskills) { - thistoken = newSVpvn(SvPVX(PL_linestr) + stuffstart, + PL_thistoken = newSVpvn(SvPVX(PL_linestr) + stuffstart, (s - SvPVX(PL_linestr)) - stuffstart); } #endif @@ -4334,9 +4356,9 @@ Perl_yylex(pTHX) PL_bufptr = s; #if 0 if (PL_madskills) { - if (!thiswhite) - thiswhite = newSVpvn("",0); - sv_catpvn(thiswhite,"}",1); + if (!PL_thiswhite) + PL_thiswhite = newSVpvn("",0); + sv_catpvn(PL_thiswhite,"}",1); } #endif return yylex(); /* ignore fake brackets */ @@ -4352,15 +4374,15 @@ Perl_yylex(pTHX) PL_bufptr = s; return yylex(); /* ignore fake brackets */ } - start_force(curforce); + start_force(PL_curforce); if (PL_madskills) { curmad('X', newSVpvn(s-1,1)); - CURMAD('_', thiswhite); + CURMAD('_', PL_thiswhite); } force_next('}'); #ifdef PERL_MAD - if (!thistoken) - thistoken = newSVpvn("",0); + if (!PL_thistoken) + PL_thistoken = newSVpvn("",0); #endif TOKEN(';'); case '&': @@ -4433,9 +4455,9 @@ Perl_yylex(pTHX) } #ifdef PERL_MAD if (PL_madskills) { - if (!thiswhite) - thiswhite = newSVpvn("",0); - sv_catpvn(thiswhite, PL_linestart, + if (!PL_thiswhite) + PL_thiswhite = newSVpvn("",0); + sv_catpvn(PL_thiswhite, PL_linestart, PL_bufend - PL_linestart); } #endif @@ -4445,12 +4467,13 @@ Perl_yylex(pTHX) } } if (PL_lex_brackets < PL_lex_formbrack) { - const char *t; + const char *t = s; #ifdef PERL_STRICT_CR - for (t = s; SPACE_OR_TAB(*t); t++) ; + while (SPACE_OR_TAB(*t)) #else - for (t = s; SPACE_OR_TAB(*t) || *t == '\r'; t++) ; + while (SPACE_OR_TAB(*t) || *t == '\r') #endif + t++; if (*t == '\n' || *t == '#') { s--; PL_expect = XBLOCK; @@ -4518,7 +4541,7 @@ Perl_yylex(pTHX) const char tmp = *s++; if (tmp == '>') SHop(OP_RIGHT_SHIFT); - if (tmp == '=') + else if (tmp == '=') Rop(OP_GE); } s--; @@ -4562,7 +4585,7 @@ Perl_yylex(pTHX) /* This kludge not intended to be bulletproof. */ if (PL_tokenbuf[1] == '[' && !PL_tokenbuf[2]) { yylval.opval = newSVOP(OP_CONST, 0, - newSViv(PL_compiling.cop_arybase)); + newSViv(CopARYBASE_get(&PL_compiling))); yylval.opval->op_private = OPpCONST_ARYBASE; TERM(THING); } @@ -4578,10 +4601,10 @@ Perl_yylex(pTHX) if (*s == '[') { PL_tokenbuf[0] = '@'; if (ckWARN(WARN_SYNTAX)) { - char *t; - for(t = s + 1; - isSPACE(*t) || isALNUM_lazy_if(t,UTF) || *t == '$'; - t++) ; + char *t = s+1; + + while (isSPACE(*t) || isALNUM_lazy_if(t,UTF) || *t == '$') + t++; if (*t++ == ',') { PL_bufptr = PEEKSPACE(PL_bufptr); /* XXX can realloc */ while (t < PL_bufend && *t != ']') @@ -4599,12 +4622,15 @@ Perl_yylex(pTHX) && (t = strchr(s, '}')) && (t = strchr(t, '='))) { char tmpbuf[sizeof PL_tokenbuf]; - for (t++; isSPACE(*t); t++) ; + do { + t++; + } while (isSPACE(*t)); if (isIDFIRST_lazy_if(t,UTF)) { STRLEN dummylen; t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &dummylen); - for (; isSPACE(*t); t++) ; + while (isSPACE(*t)) + t++; if (*t == ';' && get_cv(tmpbuf, FALSE)) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "You need to quote \"%s\"", @@ -4770,14 +4796,14 @@ Perl_yylex(pTHX) case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': s = scan_num(s, &yylval); - DEBUG_T( { S_printbuf(aTHX_ "### Saw number in %s\n", s); } ); + DEBUG_T( { printbuf("### Saw number in %s\n", s); } ); if (PL_expect == XOPERATOR) no_op("Number",s); TERM(THING); case '\'': s = scan_str(s,!!PL_madskills,FALSE); - DEBUG_T( { S_printbuf(aTHX_ "### Saw string before %s\n", s); } ); + DEBUG_T( { printbuf("### Saw string before %s\n", s); } ); if (PL_expect == XOPERATOR) { if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) { PL_expect = XTERM; @@ -4788,13 +4814,13 @@ Perl_yylex(pTHX) no_op("String",s); } if (!s) - missingterm((char*)0); + missingterm(NULL); yylval.ival = OP_CONST; TERM(sublex_start()); case '"': s = scan_str(s,!!PL_madskills,FALSE); - DEBUG_T( { S_printbuf(aTHX_ "### Saw string before %s\n", s); } ); + DEBUG_T( { printbuf("### Saw string before %s\n", s); } ); if (PL_expect == XOPERATOR) { if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) { PL_expect = XTERM; @@ -4805,7 +4831,7 @@ Perl_yylex(pTHX) no_op("String",s); } if (!s) - missingterm((char*)0); + missingterm(NULL); yylval.ival = OP_CONST; /* FIXME. I think that this can be const if char *d is replaced by more localised variables. */ @@ -4819,11 +4845,11 @@ Perl_yylex(pTHX) case '`': s = scan_str(s,!!PL_madskills,FALSE); - DEBUG_T( { S_printbuf(aTHX_ "### Saw backtick string before %s\n", s); } ); + DEBUG_T( { printbuf("### Saw backtick string before %s\n", s); } ); if (PL_expect == XOPERATOR) no_op("Backticks",s); if (!s) - missingterm((char*)0); + missingterm(NULL); yylval.ival = OP_BACKTICK; set_csh(); TERM(sublex_start()); @@ -4850,6 +4876,7 @@ Perl_yylex(pTHX) else if (!isALPHA(*start) && (PL_expect == XTERM || PL_expect == XREF || PL_expect == XSTATE || PL_expect == XTERMORDORDOR)) { + /* XXX Use gv_fetchpvn rather than stomping on a const string */ const char c = *start; GV *gv; *start = '\0'; @@ -5010,7 +5037,7 @@ Perl_yylex(pTHX) const char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]); CV *cv; #ifdef PERL_MAD - SV *nextnextwhite = 0; + SV *nextPL_nextwhite = 0; #endif @@ -5079,10 +5106,10 @@ Perl_yylex(pTHX) sv = newSVpv(PL_tokenbuf,len); } #ifdef PERL_MAD - if (PL_madskills && !thistoken) { - char *start = SvPVX(PL_linestr) + realtokenstart; - thistoken = newSVpv(start,s - start); - realtokenstart = s - SvPVX(PL_linestr); + if (PL_madskills && !PL_thistoken) { + char *start = SvPVX(PL_linestr) + PL_realtokenstart; + PL_thistoken = newSVpv(start,s - start); + PL_realtokenstart = s - SvPVX(PL_linestr); } #endif @@ -5128,9 +5155,9 @@ Perl_yylex(pTHX) bool immediate_paren = *s == '('; /* (Now we can afford to cross potential line boundary.) */ - s = SKIPSPACE2(s,nextnextwhite); + s = SKIPSPACE2(s,nextPL_nextwhite); #ifdef PERL_MAD - nextwhite = nextnextwhite; /* assume no & deception */ + PL_nextwhite = nextPL_nextwhite; /* assume no & deception */ #endif /* Two barewords in a row may indicate method call. */ @@ -5160,8 +5187,8 @@ Perl_yylex(pTHX) PL_expect = XOPERATOR; #ifdef PERL_MAD if (isSPACE(*s)) - s = SKIPSPACE2(s,nextnextwhite); - nextwhite = nextnextwhite; + s = SKIPSPACE2(s,nextPL_nextwhite); + PL_nextwhite = nextPL_nextwhite; #else s = skipspace(s); #endif @@ -5179,16 +5206,18 @@ Perl_yylex(pTHX) if (*s == '(') { CLINE; if (cv) { - for (d = s + 1; SPACE_OR_TAB(*d); d++) ; + d = s + 1; + while (SPACE_OR_TAB(*d)) + d++; if (*d == ')' && (sv = gv_const_sv(gv))) { s = d + 1; #ifdef PERL_MAD if (PL_madskills) { - char *par = SvPVX(PL_linestr) + realtokenstart; - sv_catpvn(thistoken, par, s - par); - if (nextwhite) { - sv_free(nextwhite); - nextwhite = 0; + char *par = SvPVX(PL_linestr) + PL_realtokenstart; + sv_catpvn(PL_thistoken, par, s - par); + if (PL_nextwhite) { + sv_free(PL_nextwhite); + PL_nextwhite = 0; } } #endif @@ -5197,18 +5226,18 @@ Perl_yylex(pTHX) } #ifdef PERL_MAD if (PL_madskills) { - nextwhite = thiswhite; - thiswhite = 0; + PL_nextwhite = PL_thiswhite; + PL_thiswhite = 0; } - start_force(curforce); + start_force(PL_curforce); #endif NEXTVAL_NEXTTOKE.opval = yylval.opval; PL_expect = XOPERATOR; #ifdef PERL_MAD if (PL_madskills) { - nextwhite = nextnextwhite; - curmad('X', thistoken); - thistoken = newSVpvn("",0); + PL_nextwhite = nextPL_nextwhite; + curmad('X', PL_thistoken); + PL_thistoken = newSVpvn("",0); } #endif force_next(WORD); @@ -5284,16 +5313,16 @@ Perl_yylex(pTHX) #ifdef PERL_MAD { if (PL_madskills) { - nextwhite = thiswhite; - thiswhite = 0; + PL_nextwhite = PL_thiswhite; + PL_thiswhite = 0; } - start_force(curforce); + start_force(PL_curforce); NEXTVAL_NEXTTOKE.opval = yylval.opval; PL_expect = XTERM; if (PL_madskills) { - nextwhite = nextnextwhite; - curmad('X', thistoken); - thistoken = newSVpvn("",0); + PL_nextwhite = nextPL_nextwhite; + curmad('X', PL_thistoken); + PL_thistoken = newSVpvn("",0); } force_next(WORD); TOKEN(NOAMP); @@ -5326,14 +5355,14 @@ Perl_yylex(pTHX) yylval.opval->op_private |= OPpENTERSUB_NOPAREN; PL_last_lop = PL_oldbufptr; PL_last_lop_op = OP_ENTERSUB; - nextwhite = thiswhite; - thiswhite = 0; - start_force(curforce); + PL_nextwhite = PL_thiswhite; + PL_thiswhite = 0; + start_force(PL_curforce); NEXTVAL_NEXTTOKE.opval = yylval.opval; PL_expect = XTERM; - nextwhite = nextnextwhite; - curmad('X', thistoken); - thistoken = newSVpvn("",0); + PL_nextwhite = nextPL_nextwhite; + curmad('X', PL_thistoken); + PL_thistoken = newSVpvn("",0); force_next(WORD); TOKEN(NOAMP); } @@ -5353,7 +5382,9 @@ Perl_yylex(pTHX) bareword: if (lastchar != '-') { if (ckWARN(WARN_RESERVED)) { - for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ; + d = PL_tokenbuf; + while (isLOWER(*d)) + d++; if (!*d && !gv_stashpv(PL_tokenbuf,FALSE)) Perl_warner(aTHX_ packWARN(WARN_RESERVED), PL_warn_reserved, PL_tokenbuf); @@ -5465,7 +5496,7 @@ Perl_yylex(pTHX) PUTBACK; PerlIO_apply_layers(aTHX_ PL_rsfp, NULL, Perl_form(aTHX_ ":encoding(%"SVf")", - name)); + (void*)name)); FREETMPS; LEAVE; } @@ -5473,17 +5504,17 @@ Perl_yylex(pTHX) #endif #ifdef PERL_MAD if (PL_madskills) { - if (realtokenstart >= 0) { - char *tstart = SvPVX(PL_linestr) + realtokenstart; - if (!endwhite) - endwhite = newSVpvn("",0); - sv_catsv(endwhite, thiswhite); - thiswhite = 0; - sv_catpvn(endwhite, tstart, PL_bufend - tstart); - realtokenstart = -1; + if (PL_realtokenstart >= 0) { + char *tstart = SvPVX(PL_linestr) + PL_realtokenstart; + if (!PL_endwhite) + PL_endwhite = newSVpvn("",0); + sv_catsv(PL_endwhite, PL_thiswhite); + PL_thiswhite = 0; + sv_catpvn(PL_endwhite, tstart, PL_bufend - tstart); + PL_realtokenstart = -1; } - while ((s = filter_gets(endwhite, PL_rsfp, - SvCUR(endwhite))) != Nullch) ; + while ((s = filter_gets(PL_endwhite, PL_rsfp, + SvCUR(PL_endwhite))) != Nullch) ; } #endif PL_rsfp = NULL; @@ -5945,6 +5976,7 @@ Perl_yylex(pTHX) case KEY_our: case KEY_my: + case KEY_state: PL_in_my = tmp; s = SKIPSPACE1(s); if (isIDFIRST_lazy_if(s,UTF)) { @@ -5958,14 +5990,14 @@ Perl_yylex(pTHX) if (!PL_in_my_stash) { char tmpbuf[1024]; PL_bufptr = s; - sprintf(tmpbuf, "No such class %.1000s", PL_tokenbuf); + my_snprintf(tmpbuf, sizeof(tmpbuf), "No such class %.1000s", PL_tokenbuf); yyerror(tmpbuf); } #ifdef PERL_MAD if (PL_madskills) { /* just add type to declarator token */ - sv_catsv(thistoken, nextwhite); - nextwhite = 0; - sv_catpvn(thistoken, start, s - start); + sv_catsv(PL_thistoken, PL_nextwhite); + PL_nextwhite = 0; + sv_catpvn(PL_thistoken, start, s - start); } #endif } @@ -5993,8 +6025,10 @@ Perl_yylex(pTHX) s = SKIPSPACE1(s); if (isIDFIRST_lazy_if(s,UTF)) { const char *t; - for (d = s; isALNUM_lazy_if(d,UTF); d++) ; - for (t=d; *t && isSPACE(*t); t++) ; + for (d = s; isALNUM_lazy_if(d,UTF);) + d++; + for (t=d; isSPACE(*t);) + t++; if ( *t && strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE) /* [perl #16184] */ && !(t[0] == '=' && t[1] == '>') @@ -6053,7 +6087,7 @@ Perl_yylex(pTHX) case KEY_q: s = scan_str(s,!!PL_madskills,FALSE); if (!s) - missingterm((char*)0); + missingterm(NULL); yylval.ival = OP_CONST; TERM(sublex_start()); @@ -6063,7 +6097,7 @@ Perl_yylex(pTHX) case KEY_qw: s = scan_str(s,!!PL_madskills,FALSE); if (!s) - missingterm((char*)0); + missingterm(NULL); PL_expect = XOPERATOR; force_next(')'); if (SvCUR(PL_lex_stuff)) { @@ -6071,9 +6105,10 @@ Perl_yylex(pTHX) int warned = 0; d = SvPV_force(PL_lex_stuff, len); while (len) { - SV *sv; - for (; isSPACE(*d) && len; --len, ++d) ; + for (; isSPACE(*d) && len; --len, ++d) + /**/; if (len) { + SV *sv; const char *b = d; if (!warned && ckWARN(WARN_QW)) { for (; !isSPACE(*d) && len; --len, ++d) { @@ -6090,7 +6125,8 @@ Perl_yylex(pTHX) } } else { - for (; !isSPACE(*d) && len; --len, ++d) ; + for (; !isSPACE(*d) && len; --len, ++d) + /**/; } sv = newSVpvn(b, d-b); if (DO_UTF8(PL_lex_stuff)) @@ -6100,7 +6136,7 @@ Perl_yylex(pTHX) } } if (words) { - start_force(curforce); + start_force(PL_curforce); NEXTVAL_NEXTTOKE.opval = words; force_next(THING); } @@ -6115,7 +6151,7 @@ Perl_yylex(pTHX) case KEY_qq: s = scan_str(s,!!PL_madskills,FALSE); if (!s) - missingterm((char*)0); + missingterm(NULL); yylval.ival = OP_STRINGIFY; if (SvIVX(PL_lex_stuff) == '\'') SvIV_set(PL_lex_stuff, 0); /* qq'$foo' should intepolate */ @@ -6128,7 +6164,7 @@ Perl_yylex(pTHX) case KEY_qx: s = scan_str(s,!!PL_madskills,FALSE); if (!s) - missingterm((char*)0); + missingterm(NULL); yylval.ival = OP_BACKTICK; set_csh(); TERM(sublex_start()); @@ -6353,9 +6389,9 @@ Perl_yylex(pTHX) #ifdef PERL_MAD SV *tmpwhite = 0; - char *tstart = SvPVX(PL_linestr) + realtokenstart; + char *tstart = SvPVX(PL_linestr) + PL_realtokenstart; SV *subtoken = newSVpvn(tstart, s - tstart); - thistoken = 0; + PL_thistoken = 0; d = s; s = SKIPSPACE2(s,tmpwhite); @@ -6414,7 +6450,7 @@ Perl_yylex(pTHX) if (*s == '=') PL_lex_formbrack = PL_lex_brackets + 1; #ifdef PERL_MAD - thistoken = subtoken; + PL_thistoken = subtoken; s = d; #else if (have_name) @@ -6446,16 +6482,16 @@ Perl_yylex(pTHX) if (bad_proto && ckWARN(WARN_SYNTAX)) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Illegal character in prototype for %"SVf" : %s", - PL_subname, d); + (void*)PL_subname, d); SvCUR_set(PL_lex_stuff, tmp); have_proto = TRUE; #ifdef PERL_MAD start_force(0); - CURMAD('q', thisopen); + CURMAD('q', PL_thisopen); CURMAD('_', tmpwhite); - CURMAD('=', thisstuff); - CURMAD('Q', thisclose); + CURMAD('=', PL_thisstuff); + CURMAD('Q', PL_thisclose); NEXTVAL_NEXTTOKE.opval = (OP*)newSVOP(OP_CONST, 0, PL_lex_stuff); PL_lex_stuff = Nullsv; @@ -6475,7 +6511,7 @@ Perl_yylex(pTHX) if (!have_name) Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine"); else if (*s != ';') - Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, PL_subname); + Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, (void*)PL_subname); } #ifdef PERL_MAD @@ -6487,7 +6523,7 @@ Perl_yylex(pTHX) } force_next(0); - thistoken = subtoken; + PL_thistoken = subtoken; #else if (have_proto) { NEXTVAL_NEXTTOKE.opval = @@ -6667,7 +6703,7 @@ S_pending_ident(pTHX) char pit = PL_pending_ident; PL_pending_ident = 0; - /* realtokenstart = realtokenend = PL_bufptr - SvPVX(PL_linestr); */ + /* PL_realtokenstart = realtokenend = PL_bufptr - SvPVX(PL_linestr); */ DEBUG_T({ PerlIO_printf(Perl_debug_log, "### Pending identifier '%s'\n", PL_tokenbuf); }); @@ -6687,7 +6723,8 @@ S_pending_ident(pTHX) } else { if (strchr(PL_tokenbuf,':')) - yyerror(Perl_form(aTHX_ PL_no_myglob,PL_tokenbuf)); + yyerror(Perl_form(aTHX_ PL_no_myglob, + PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf)); yylval.opval = newOP(OP_PADANY, 0); yylval.opval->op_targ = allocmy(PL_tokenbuf); @@ -6805,7 +6842,7 @@ S_pending_ident(pTHX) I32 Perl_keyword (pTHX_ const char *name, I32 len) { - dVAR; + dVAR; switch (len) { case 1: /* 5 tokens of length 1 */ @@ -7712,46 +7749,46 @@ Perl_keyword (pTHX_ const char *name, I32 len) switch (name[1]) { case 'a': - switch (name[2]) - { - case 'i': - if (name[3] == 't') - { /* wait */ - return -KEY_wait; - } + switch (name[2]) + { + case 'i': + if (name[3] == 't') + { /* wait */ + return -KEY_wait; + } - goto unknown; + goto unknown; - case 'r': - if (name[3] == 'n') - { /* warn */ - return -KEY_warn; - } + case 'r': + if (name[3] == 'n') + { /* warn */ + return -KEY_warn; + } - goto unknown; + goto unknown; - default: - goto unknown; - } + default: + goto unknown; + } case 'h': if (name[2] == 'e' && name[3] == 'n') { /* when */ return (FEATURE_IS_ENABLED("switch") ? KEY_when : 0); - } + } - goto unknown; + goto unknown; - default: - goto unknown; - } + default: + goto unknown; + } default: goto unknown; } - case 5: /* 38 tokens of length 5 */ + case 5: /* 39 tokens of length 5 */ switch (name[0]) { case 'B': @@ -7808,13 +7845,13 @@ Perl_keyword (pTHX_ const char *name, I32 len) { case 'l': if (name[2] == 'e' && - name[3] == 's' && - name[4] == 's') - { /* bless */ - return -KEY_bless; - } + name[3] == 's' && + name[4] == 's') + { /* bless */ + return -KEY_bless; + } - goto unknown; + goto unknown; case 'r': if (name[2] == 'e' && @@ -8111,14 +8148,29 @@ Perl_keyword (pTHX_ const char *name, I32 len) goto unknown; case 't': - if (name[2] == 'u' && - name[3] == 'd' && - name[4] == 'y') - { /* study */ - return KEY_study; - } + switch (name[2]) + { + case 'a': + if (name[3] == 't' && + name[4] == 'e') + { /* state */ + return (FEATURE_IS_ENABLED("state") ? KEY_state : 0); + } - goto unknown; + goto unknown; + + case 'u': + if (name[3] == 'd' && + name[4] == 'y') + { /* study */ + return KEY_study; + } + + goto unknown; + + default: + goto unknown; + } default: goto unknown; @@ -8777,17 +8829,17 @@ Perl_keyword (pTHX_ const char *name, I32 len) case 'i': if (name[4] == 'n' && - name[5] == 'e' && - name[6] == 'd') - { /* defined */ - return KEY_defined; - } + name[5] == 'e' && + name[6] == 'd') + { /* defined */ + return KEY_defined; + } - goto unknown; + goto unknown; - default: - goto unknown; - } + default: + goto unknown; + } } goto unknown; @@ -10168,22 +10220,22 @@ unknown: } STATIC void -S_checkcomma(pTHX_ register char *s, const char *name, const char *what) +S_checkcomma(pTHX_ const char *s, const char *name, const char *what) { dVAR; - const char *w; if (*s == ' ' && s[1] == '(') { /* XXX gotta be a better way */ if (ckWARN(WARN_SYNTAX)) { int level = 1; + const char *w; for (w = s+2; *w && level; w++) { if (*w == '(') ++level; else if (*w == ')') --level; } - if (*w) - for (; *w && isSPACE(*w); w++) ; + while (isSPACE(*w)) + ++w; if (!*w || !strchr(";|})]oaiuw!=", *w)) /* an advisory hack only... */ Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%s (...) interpreted as function",name); @@ -10196,17 +10248,18 @@ S_checkcomma(pTHX_ register char *s, const char *name, const char *what) while (s < PL_bufend && isSPACE(*s)) s++; if (isIDFIRST_lazy_if(s,UTF)) { - w = s++; + const char * const w = s++; while (isALNUM_lazy_if(s,UTF)) s++; while (s < PL_bufend && isSPACE(*s)) s++; if (*s == ',') { - I32 kw; - *s = '\0'; /* XXX If we didn't do this, we could const a lot of toke.c */ - kw = keyword(w, s - w) || get_cv(w, FALSE) != 0; - *s = ','; - if (kw) + GV* gv; + if (keyword(w, s - w)) + return; + + gv = gv_fetchpvn_flags(w, s - w, 0, SVt_PVCV); + if (gv && GvCVu(gv)) return; Perl_croak(aTHX_ "No comma allowed after %s", what); } @@ -10327,23 +10380,25 @@ S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_packag Perl_croak(aTHX_ ident_too_long); if (isALNUM(*s)) /* UTF handled below */ *d++ = *s++; - else if (*s == '\'' && allow_package && isIDFIRST_lazy_if(s+1,UTF)) { + else if (allow_package && (*s == '\'') && isIDFIRST_lazy_if(s+1,UTF)) { *d++ = ':'; *d++ = ':'; s++; } - else if (*s == ':' && s[1] == ':' && allow_package && s[2] != '$') { + else if (allow_package && (s[0] == ':') && (s[1] == ':') && (s[2] != '$')) { *d++ = *s++; *d++ = *s++; } else if (UTF && UTF8_IS_START(*s) && isALNUM_utf8((U8*)s)) { char *t = s + UTF8SKIP(s); + size_t len; while (UTF8_IS_CONTINUED(*t) && is_utf8_mark((U8*)t)) t += UTF8SKIP(t); - if (d + (t - s) > e) + len = t - s; + if (d + len > e) Perl_croak(aTHX_ ident_too_long); - Copy(s, d, t - s, char); - d += t - s; + Copy(s, d, len, char); + d += len; s = t; } else { @@ -10456,10 +10511,11 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL Perl_croak(aTHX_ ident_too_long); } *d = '\0'; - while (s < send && SPACE_OR_TAB(*s)) s++; + while (s < send && SPACE_OR_TAB(*s)) + s++; if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) { if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) { - const char *brack = *s == '[' ? "[...]" : "{...}"; + const char * const brack = (*s == '[') ? "[...]" : "{...}"; Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "Ambiguous use of %c{%s%s} resolved to %c%s%s", funny, dest, brack, funny, dest, brack); @@ -10488,12 +10544,12 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL PL_lex_state = LEX_INTERPEND; PL_expect = XREF; } - if (funny == '#') - funny = '@'; if (PL_lex_state == LEX_NORMAL) { if (ckWARN(WARN_AMBIGUOUS) && (keyword(dest, d - dest) || get_cv(dest, FALSE))) { + if (funny == '#') + funny = '@'; Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "Ambiguous use of %c{%s} resolved to %c%s", funny, dest, funny, dest); @@ -10600,11 +10656,11 @@ S_scan_subst(pTHX_ char *start) s--; #ifdef PERL_MAD if (PL_madskills) { - CURMAD('q', thisopen); - CURMAD('_', thiswhite); - CURMAD('E', thisstuff); - CURMAD('Q', thisclose); - realtokenstart = s - SvPVX(PL_linestr); + CURMAD('q', PL_thisopen); + CURMAD('_', PL_thiswhite); + CURMAD('E', PL_thisstuff); + CURMAD('Q', PL_thisclose); + PL_realtokenstart = s - SvPVX(PL_linestr); } #endif @@ -10623,9 +10679,9 @@ S_scan_subst(pTHX_ char *start) #ifdef PERL_MAD if (PL_madskills) { - CURMAD('z', thisopen); - CURMAD('R', thisstuff); - CURMAD('Z', thisclose); + CURMAD('z', PL_thisopen); + CURMAD('R', PL_thisstuff); + CURMAD('Z', PL_thisclose); } modstart = s; #endif @@ -10645,8 +10701,8 @@ S_scan_subst(pTHX_ char *start) if (PL_madskills) { if (modstart != s) curmad('m', newSVpvn(modstart, s - modstart)); - append_madprops(thismad, (OP*)pm, 0); - thismad = 0; + append_madprops(PL_thismad, (OP*)pm, 0); + PL_thismad = 0; } #endif if ((pm->op_pmflags & PMf_CONTINUE) && ckWARN(WARN_REGEXP)) { @@ -10700,11 +10756,11 @@ S_scan_trans(pTHX_ char *start) s--; #ifdef PERL_MAD if (PL_madskills) { - CURMAD('q', thisopen); - CURMAD('_', thiswhite); - CURMAD('E', thisstuff); - CURMAD('Q', thisclose); - realtokenstart = s - SvPVX(PL_linestr); + CURMAD('q', PL_thisopen); + CURMAD('_', PL_thiswhite); + CURMAD('E', PL_thisstuff); + CURMAD('Q', PL_thisclose); + PL_realtokenstart = s - SvPVX(PL_linestr); } #endif @@ -10717,9 +10773,9 @@ S_scan_trans(pTHX_ char *start) Perl_croak(aTHX_ "Transliteration replacement not terminated"); } if (PL_madskills) { - CURMAD('z', thisopen); - CURMAD('R', thisstuff); - CURMAD('Z', thisclose); + CURMAD('z', PL_thisopen); + CURMAD('R', PL_thisstuff); + CURMAD('Z', PL_thisclose); } complement = del = squash = 0; @@ -10758,8 +10814,8 @@ S_scan_trans(pTHX_ char *start) if (PL_madskills) { if (modstart != s) curmad('m', newSVpvn(modstart, s - modstart)); - append_madprops(thismad, o, 0); - thismad = 0; + append_madprops(PL_thismad, o, 0); + PL_thismad = 0; } #endif @@ -10784,7 +10840,7 @@ S_scan_heredoc(pTHX_ register char *s) I32 stuffstart = s - SvPVX(PL_linestr); char *tstart; - realtokenstart = -1; + PL_realtokenstart = -1; #endif s += 2; @@ -10792,7 +10848,9 @@ S_scan_heredoc(pTHX_ register char *s) e = PL_tokenbuf + sizeof PL_tokenbuf - 1; if (!outer) *d++ = '\n'; - for (peek = s; SPACE_OR_TAB(*peek); peek++) ; + peek = s; + while (SPACE_OR_TAB(*peek)) + peek++; if (*peek == '`' || *peek == '\'' || *peek =='"') { s = peek; term = *s++; @@ -10822,9 +10880,9 @@ S_scan_heredoc(pTHX_ register char *s) #ifdef PERL_MAD if (PL_madskills) { tstart = PL_tokenbuf + !outer; - thisclose = newSVpvn(tstart, len - !outer); + PL_thisclose = newSVpvn(tstart, len - !outer); tstart = SvPVX(PL_linestr) + stuffstart; - thisopen = newSVpvn(tstart, s - tstart); + PL_thisopen = newSVpvn(tstart, s - tstart); stuffstart = s - SvPVX(PL_linestr); } #endif @@ -10869,10 +10927,10 @@ S_scan_heredoc(pTHX_ register char *s) #ifdef PERL_MAD if (PL_madskills) { tstart = SvPVX(PL_linestr) + stuffstart; - if (thisstuff) - sv_catpvn(thisstuff, tstart, s - tstart); + if (PL_thisstuff) + sv_catpvn(PL_thisstuff, tstart, s - tstart); else - thisstuff = newSVpvn(tstart, s - tstart); + PL_thisstuff = newSVpvn(tstart, s - tstart); } #endif s += SvCUR(herewas); @@ -10939,10 +10997,10 @@ S_scan_heredoc(pTHX_ register char *s) sv_setpvn(tmpstr,d+1,s-d); #ifdef PERL_MAD if (PL_madskills) { - if (thisstuff) - sv_catpvn(thisstuff, d + 1, s - d); + if (PL_thisstuff) + sv_catpvn(PL_thisstuff, d + 1, s - d); else - thisstuff = newSVpvn(d + 1, s - d); + PL_thisstuff = newSVpvn(d + 1, s - d); stuffstart = s - SvPVX(PL_linestr); } #endif @@ -10961,10 +11019,10 @@ S_scan_heredoc(pTHX_ register char *s) #ifdef PERL_MAD if (PL_madskills) { tstart = SvPVX(PL_linestr) + stuffstart; - if (thisstuff) - sv_catpvn(thisstuff, tstart, PL_bufend - tstart); + if (PL_thisstuff) + sv_catpvn(PL_thisstuff, tstart, PL_bufend - tstart); else - thisstuff = newSVpvn(tstart, PL_bufend - tstart); + PL_thisstuff = newSVpvn(tstart, PL_bufend - tstart); } #endif if (!outer || @@ -11068,7 +11126,7 @@ S_scan_inputsymbol(pTHX_ char *start) or if it didn't end, or if we see a newline */ - if (len >= sizeof PL_tokenbuf) + if (len >= (I32)sizeof PL_tokenbuf) Perl_croak(aTHX_ "Excessively long <> operator"); if (s >= end) Perl_croak(aTHX_ "Unterminated <> operator"); @@ -11263,9 +11321,9 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) } #ifdef PERL_MAD - if (realtokenstart >= 0) { - stuffstart = realtokenstart; - realtokenstart = -1; + if (PL_realtokenstart >= 0) { + stuffstart = PL_realtokenstart; + PL_realtokenstart = -1; } else stuffstart = start - SvPVX(PL_linestr); @@ -11309,8 +11367,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) s += termlen; #ifdef PERL_MAD tstart = SvPVX(PL_linestr) + stuffstart; - if (!thisopen && !keep_delims) { - thisopen = newSVpvn(tstart, s - tstart); + if (!PL_thisopen && !keep_delims) { + PL_thisopen = newSVpvn(tstart, s - tstart); stuffstart = s - SvPVX(PL_linestr); } #endif @@ -11480,11 +11538,11 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) */ #ifdef PERL_MAD if (PL_madskills) { - char *tstart = SvPVX(PL_linestr) + stuffstart; - if (thisstuff) - sv_catpvn(thisstuff, tstart, PL_bufend - tstart); + char * const tstart = SvPVX(PL_linestr) + stuffstart; + if (PL_thisstuff) + sv_catpvn(PL_thisstuff, tstart, PL_bufend - tstart); else - thisstuff = newSVpvn(tstart, PL_bufend - tstart); + PL_thisstuff = newSVpvn(tstart, PL_bufend - tstart); } #endif if (!PL_rsfp || @@ -11520,13 +11578,14 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) if (!PL_encoding || UTF) { #ifdef PERL_MAD if (PL_madskills) { - char *tstart = SvPVX(PL_linestr) + stuffstart; - if (thisstuff) - sv_catpvn(thisstuff, tstart, s - tstart); + char * const tstart = SvPVX(PL_linestr) + stuffstart; + const int len = s - start; + if (PL_thisstuff) + sv_catpvn(PL_thisstuff, tstart, len); else - thisstuff = newSVpvn(tstart, s - tstart); - if (!thisclose && !keep_delims) - thisclose = newSVpvn(s,termlen); + PL_thisstuff = newSVpvn(tstart, len); + if (!PL_thisclose && !keep_delims) + PL_thisclose = newSVpvn(s,termlen); } #endif @@ -11537,13 +11596,14 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) #ifdef PERL_MAD else { if (PL_madskills) { - char *tstart = SvPVX(PL_linestr) + stuffstart; - if (thisstuff) - sv_catpvn(thisstuff, tstart, s - tstart - termlen); + char * const tstart = SvPVX(PL_linestr) + stuffstart; + const int len = s - tstart - termlen; + if (PL_thisstuff) + sv_catpvn(PL_thisstuff, tstart, len); else - thisstuff = newSVpvn(tstart, s - tstart - termlen); - if (!thisclose && !keep_delims) - thisclose = newSVpvn(s - termlen,termlen); + PL_thisstuff = newSVpvn(tstart, len); + if (!PL_thisclose && !keep_delims) + PL_thisclose = newSVpvn(s - termlen,termlen); } } #endif @@ -11987,17 +12047,20 @@ S_scan_formline(pTHX_ register char *s) SV* savewhite; if (PL_madskills) { - savewhite = thiswhite; - thiswhite = 0; + savewhite = PL_thiswhite; + PL_thiswhite = 0; } #endif while (!needargs) { if (*s == '.') { + t = s+1; #ifdef PERL_STRICT_CR - for (t = s+1;SPACE_OR_TAB(*t); t++) ; + while (SPACE_OR_TAB(*t)) + t++; #else - for (t = s+1;SPACE_OR_TAB(*t) || *t == '\r'; t++) ; + while (SPACE_OR_TAB(*t) || *t == '\r') + t++; #endif if (*t == '\n' || t == PL_bufend) { eofmt = TRUE; @@ -12038,10 +12101,10 @@ S_scan_formline(pTHX_ register char *s) if (PL_rsfp) { #ifdef PERL_MAD if (PL_madskills) { - if (thistoken) - sv_catpvn(thistoken, tokenstart, PL_bufend - tokenstart); + if (PL_thistoken) + sv_catpvn(PL_thistoken, tokenstart, PL_bufend - tokenstart); else - thistoken = newSVpvn(tokenstart, PL_bufend - tokenstart); + PL_thistoken = newSVpvn(tokenstart, PL_bufend - tokenstart); } #endif s = filter_gets(PL_linestr, PL_rsfp, 0); @@ -12064,7 +12127,7 @@ S_scan_formline(pTHX_ register char *s) PL_expect = XTERM; if (needargs) { PL_lex_state = LEX_NORMAL; - start_force(curforce); + start_force(PL_curforce); NEXTVAL_NEXTTOKE.ival = 0; force_next(','); } @@ -12076,10 +12139,10 @@ S_scan_formline(pTHX_ register char *s) else if (PL_encoding) sv_recode_to_utf8(stuff, PL_encoding); } - start_force(curforce); + start_force(PL_curforce); NEXTVAL_NEXTTOKE.opval = (OP*)newSVOP(OP_CONST, 0, stuff); force_next(THING); - start_force(curforce); + start_force(PL_curforce); NEXTVAL_NEXTTOKE.ival = OP_FORMLINE; force_next(LSTOP); } @@ -12091,11 +12154,11 @@ S_scan_formline(pTHX_ register char *s) } #ifdef PERL_MAD if (PL_madskills) { - if (thistoken) - sv_catpvn(thistoken, tokenstart, s - tokenstart); + if (PL_thistoken) + sv_catpvn(PL_thistoken, tokenstart, s - tokenstart); else - thistoken = newSVpvn(tokenstart, s - tokenstart); - thiswhite = savewhite; + PL_thistoken = newSVpvn(tokenstart, s - tokenstart); + PL_thiswhite = savewhite; } #endif return s; @@ -12233,13 +12296,13 @@ Perl_yyerror(pTHX_ const char *s) PL_multi_end = 0; } if (PL_in_eval & EVAL_WARNONLY && ckWARN_d(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, msg); + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, (void*)msg); else qerror(msg); if (PL_error_count >= 10) { if (PL_in_eval && SvCUR(ERRSV)) Perl_croak(aTHX_ "%"SVf"%s has too many errors.\n", - ERRSV, OutCopFILE(PL_curcop)); + (void*)ERRSV, OutCopFILE(PL_curcop)); else Perl_croak(aTHX_ "%s has too many errors.\n", OutCopFILE(PL_curcop)); @@ -12383,7 +12446,8 @@ utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) const I32 count = FILTER_READ(idx+1, sv, maxlen); DEBUG_P(PerlIO_printf(Perl_debug_log, "utf16_textfilter(%p): %d %d (%d)\n", - utf16_textfilter, idx, maxlen, (int) count)); + FPTR2DPTR(void *, utf16_textfilter), + idx, maxlen, (int) count)); if (count) { U8* tmps; I32 newlen; @@ -12405,7 +12469,8 @@ utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen) const I32 count = FILTER_READ(idx+1, sv, maxlen); DEBUG_P(PerlIO_printf(Perl_debug_log, "utf16rev_textfilter(%p): %d %d (%d)\n", - utf16rev_textfilter, idx, maxlen, (int) count)); + FPTR2DPTR(void *, utf16rev_textfilter), + idx, maxlen, (int) count)); if (count) { U8* tmps; I32 newlen; @@ -12458,22 +12523,20 @@ Perl_scan_vstring(pTHX_ const char *s, SV *sv) if (!isALPHA(*pos)) { U8 tmpbuf[UTF8_MAXBYTES+1]; - if (*s == 'v') s++; /* get past 'v' */ + if (*s == 'v') + s++; /* get past 'v' */ sv_setpvn(sv, "", 0); for (;;) { + /* this is atoi() that tolerates underscores */ U8 *tmpend; UV rev = 0; - { - /* this is atoi() that tolerates underscores */ - const char *end = pos; - UV mult = 1; - while (--end >= s) { - UV orev; - if (*end == '_') - continue; - orev = rev; + const char *end = pos; + UV mult = 1; + while (--end >= s) { + if (*end != '_') { + const UV orev = rev; rev += (*end - '0') * mult; mult *= 10; if (orev > rev && ckWARN_d(WARN_OVERFLOW))