X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=d89ac738be3b359d5e1f835f8b9b4cc83d85a325;hb=6c1b96a17296a211cb3d88901a67369582176a79;hp=d35227fae40985197aaad302b9a06ae5a829a23c;hpb=27da23d53ccce622bc51822f59df8def79b4df95;p=p5sagit%2Fp5-mst-13.2.git diff --git a/toke.c b/toke.c index d35227f..d89ac73 100644 --- a/toke.c +++ b/toke.c @@ -167,25 +167,29 @@ static const char* const lex_state_names[] = { * The UNIDOR macro is for unary functions that can be followed by the // * operator (such as C). */ -#define UNI2(f,x) return ( \ - yylval.ival = f, \ - PL_expect = x, \ - PL_bufptr = s, \ - PL_last_uni = PL_oldbufptr, \ - PL_last_lop_op = f, \ - REPORT( \ - (*s == '(' || (s = skipspace(s), *s == '(') \ - ? (int)FUNC1 : (int)UNIOP))) +#define UNI2(f,x) { \ + yylval.ival = f; \ + PL_expect = x; \ + PL_bufptr = s; \ + PL_last_uni = PL_oldbufptr; \ + PL_last_lop_op = f; \ + if (*s == '(') \ + return REPORT( (int)FUNC1 ); \ + s = skipspace(s); \ + return REPORT( *s=='(' ? (int)FUNC1 : (int)UNIOP ); \ + } #define UNI(f) UNI2(f,XTERM) #define UNIDOR(f) UNI2(f,XTERMORDORDOR) -#define UNIBRACK(f) return ( \ - yylval.ival = f, \ - PL_bufptr = s, \ - PL_last_uni = PL_oldbufptr, \ - REPORT( \ - (*s == '(' || (s = skipspace(s), *s == '(') \ - ? (int)FUNC1 : (int)UNIOP))) +#define UNIBRACK(f) { \ + yylval.ival = f; \ + PL_bufptr = s; \ + PL_last_uni = PL_oldbufptr; \ + if (*s == '(') \ + return REPORT( (int)FUNC1 ); \ + s = skipspace(s); \ + return REPORT( (*s == '(') ? (int)FUNC1 : (int)UNIOP ); \ + } /* grandfather return to old style */ #define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP) @@ -278,7 +282,7 @@ S_tokereport(pTHX_ const char* s, I32 rv) if (DEBUG_T_TEST) { const char *name = Nullch; enum token_type type = TOKENTYPE_NONE; - struct debug_tokens *p; + const struct debug_tokens *p; SV* report = newSVpvn("<== ", 4); for (p = debug_tokens; p->token; p++) { @@ -325,7 +329,7 @@ S_tokereport(pTHX_ const char* s, I32 rv) if (PL_oldbufptr && *PL_oldbufptr) sv_catpv(report, PL_tokenbuf); } - PerlIO_printf(Perl_debug_log, "### %s]\n", SvPV_nolen(report)); + PerlIO_printf(Perl_debug_log, "### %s]\n", SvPV_nolen_const(report)); }; return (int)rv; } @@ -384,7 +388,7 @@ S_no_op(pTHX_ const char *what, char *s) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "\t(Missing semicolon on previous line?)\n"); else if (PL_oldoldbufptr && isIDFIRST_lazy_if(PL_oldoldbufptr,UTF)) { - char *t; + const char *t; for (t = PL_oldoldbufptr; *t && (isALNUM_lazy_if(t,UTF) || *t == ':'); t++) ; if (t < PL_bufptr && isSPACE(*t)) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), @@ -487,8 +491,8 @@ S_depcom(pTHX) static void strip_return(SV *sv) { - register char *s = SvPVX(sv); - register char *e = s + SvCUR(sv); + register const char *s = SvPVX_const(sv); + register const char *e = s + SvCUR(sv); /* outer loop optimized to do nothing if there are no CR-LFs */ while (s < e) { if (*s++ == '\r' && *s == '\n') { @@ -509,7 +513,7 @@ strip_return(SV *sv) STATIC I32 S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen) { - I32 count = FILTER_READ(idx+1, sv, maxlen); + const I32 count = FILTER_READ(idx+1, sv, maxlen); if (count > 0 && !maxlen) strip_return(sv); return count; @@ -525,7 +529,7 @@ S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen) void Perl_lex_start(pTHX_ SV *line) { - char *s; + const char *s; STRLEN len; SAVEI32(PL_lex_dojoin); @@ -581,7 +585,7 @@ Perl_lex_start(pTHX_ SV *line) PL_linestr = line; if (SvREADONLY(PL_linestr)) PL_linestr = sv_2mortal(newSVsv(PL_linestr)); - s = SvPV(PL_linestr, len); + s = SvPV_const(PL_linestr, len); if (!len || s[len-1] != ';') { if (!(SvFLAGS(PL_linestr) & SVs_TEMP)) PL_linestr = sv_2mortal(newSVsv(PL_linestr)); @@ -967,9 +971,9 @@ Perl_str_to_version(pTHX_ SV *sv) NV retval = 0.0; NV nshift = 1.0; STRLEN len; - char *start = SvPVx(sv,len); - bool utf = SvUTF8(sv) ? TRUE : FALSE; - char *end = start + len; + const char *start = SvPV_const(sv,len); + const char *end = start + len; + const bool utf = SvUTF8(sv) ? TRUE : FALSE; while (start < end) { STRLEN skip; UV n; @@ -1014,7 +1018,7 @@ S_force_version(pTHX_ char *s, int guessing) version = yylval.opval; ver = cSVOPx(version)->op_sv; if (SvPOK(ver) && !SvNIOK(ver)) { - (void)SvUPGRADE(ver, SVt_PVNV); + SvUPGRADE(ver, SVt_PVNV); SvNV_set(ver, str_to_version(ver)); SvNOK_on(ver); /* hint that it is a version */ } @@ -1060,7 +1064,7 @@ S_tokeq(pTHX_ SV *sv) goto finish; d = s; if ( PL_hints & HINT_NEW_STRING ) { - pv = sv_2mortal(newSVpvn(SvPVX(pv), len)); + pv = sv_2mortal(newSVpvn(SvPVX_const(pv), len)); if (SvUTF8(sv)) SvUTF8_on(pv); } @@ -1072,7 +1076,7 @@ S_tokeq(pTHX_ SV *sv) *d++ = *s++; } *d = '\0'; - SvCUR_set(sv, d - SvPVX(sv)); + SvCUR_set(sv, d - SvPVX_const(sv)); finish: if ( PL_hints & HINT_NEW_STRING ) return new_constant(NULL, 0, "q", sv, pv, "q"); @@ -1114,7 +1118,7 @@ S_tokeq(pTHX_ SV *sv) STATIC I32 S_sublex_start(pTHX) { - register I32 op_type = yylval.ival; + const register I32 op_type = yylval.ival; if (op_type == OP_NULL) { yylval.opval = PL_lex_op; @@ -1127,11 +1131,8 @@ S_sublex_start(pTHX) if (SvTYPE(sv) == SVt_PVIV) { /* Overloaded constants, nothing fancy: Convert to SVt_PV: */ STRLEN len; - char *p; - SV *nsv; - - p = SvPV(sv, len); - nsv = newSVpvn(p, len); + const char *p = SvPV_const(sv, len); + SV * const nsv = newSVpvn(p, len); if (SvUTF8(sv)) SvUTF8_on(nsv); SvREFCNT_dec(sv); @@ -1401,7 +1402,7 @@ S_scan_const(pTHX_ char *start) continue; } - i = d - SvPVX(sv); /* remember current offset */ + i = d - SvPVX_const(sv); /* remember current offset */ SvGROW(sv, SvLEN(sv) + 256); /* never more than 256 chars in a range */ d = SvPVX(sv) + i; /* refresh d after realloc */ d -= 2; /* eat the first char and the - */ @@ -1628,13 +1629,13 @@ S_scan_const(pTHX_ char *start) } } if (hicount) { - STRLEN offset = d - SvPVX(sv); + STRLEN offset = d - SvPVX_const(sv); U8 *src, *dst; d = SvGROW(sv, SvLEN(sv) + hicount + 1) + offset; src = (U8 *)d - 1; dst = src+hicount; d += hicount; - while (src >= (U8 *)SvPVX(sv)) { + while (src >= (const U8 *)SvPVX_const(sv)) { if (!NATIVE_IS_INVARIANT(*src)) { U8 ch = NATIVE_TO_ASCII(*src); *dst-- = (U8)UTF8_EIGHT_BIT_LO(ch); @@ -1674,7 +1675,7 @@ S_scan_const(pTHX_ char *start) char* e = strchr(s, '}'); SV *res; STRLEN len; - char *str; + const char *str; if (!e) { yyerror("Missing right brace on \\N{}"); @@ -1696,7 +1697,7 @@ S_scan_const(pTHX_ char *start) res, Nullsv, "\\N{...}" ); if (has_utf8) sv_utf8_upgrade(res); - str = SvPV(res,len); + str = SvPV_const(res,len); #ifdef EBCDIC_NEVER_MIND /* charnames uses pack U and that has been * recently changed to do the below uni->native @@ -1706,19 +1707,19 @@ S_scan_const(pTHX_ char *start) * gets revoked, but the semantics is still * desireable for charnames. --jhi */ { - UV uv = utf8_to_uvchr((U8*)str, 0); + UV uv = utf8_to_uvchr((const U8*)str, 0); if (uv < 0x100) { U8 tmpbuf[UTF8_MAXBYTES+1], *d; d = uvchr_to_utf8(tmpbuf, UNI_TO_NATIVE(uv)); sv_setpvn(res, (char *)tmpbuf, d - tmpbuf); - str = SvPV(res, len); + str = SvPV_const(res, len); } } #endif if (!has_utf8 && SvUTF8(res)) { - char *ostart = SvPVX(sv); + const char *ostart = SvPVX_const(sv); SvCUR_set(sv, d - ostart); SvPOK_on(sv); *d = '\0'; @@ -1729,7 +1730,7 @@ S_scan_const(pTHX_ char *start) has_utf8 = TRUE; } if (len > (STRLEN)(e - s + 4)) { /* I _guess_ 4 is \N{} --jhi */ - char *odest = SvPVX(sv); + const char *odest = SvPVX_const(sv); SvGROW(sv, (SvLEN(sv) + len - (e - s + 4))); d = SvPVX(sv) + (d - odest); @@ -1798,7 +1799,7 @@ S_scan_const(pTHX_ char *start) s += len; if (need > len) { /* encoded value larger than old, need extra space (NOTE: SvCUR() not set here) */ - STRLEN off = d - SvPVX(sv); + STRLEN off = d - SvPVX_const(sv); d = SvGROW(sv, SvLEN(sv) + (need-len)) + off; } d = (char*)uvchr_to_utf8((U8*)d, uv); @@ -1811,7 +1812,7 @@ S_scan_const(pTHX_ char *start) /* terminate the string and set up the sv */ *d = '\0'; - SvCUR_set(sv, d - SvPVX(sv)); + SvCUR_set(sv, d - SvPVX_const(sv)); if (SvCUR(sv) >= SvLEN(sv)) Perl_croak(aTHX_ "panic: constant overflowed allocated space"); @@ -1910,7 +1911,7 @@ S_intuit_more(pTHX_ register char *s) int weight = 2; /* let's weigh the evidence */ char seen[256]; unsigned char un_char = 255, last_un_char; - char *send = strchr(s,']'); + const char *send = strchr(s,']'); char tmpbuf[sizeof PL_tokenbuf * 4]; if (!send) /* has to be an expression */ @@ -2038,7 +2039,7 @@ S_intuit_method(pTHX_ char *start, GV *gv) if (GvIO(gv)) return 0; if ((cv = GvCVu(gv))) { - char *proto = SvPVX(cv); + const char *proto = SvPVX_const(cv); if (proto) { if (*proto == ';') proto++; @@ -2138,12 +2139,11 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) PL_rsfp_filters = newAV(); if (!datasv) datasv = NEWSV(255,0); - if (!SvUPGRADE(datasv, SVt_PVIO)) - Perl_die(aTHX_ "Can't upgrade filter_add data to SVt_PVIO"); - IoANY(datasv) = (void *)funcp; /* stash funcp into spare field */ + SvUPGRADE(datasv, SVt_PVIO); + 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", - (void*)funcp, SvPV_nolen(datasv))); + IoANY(datasv), SvPV_nolen(datasv))); av_unshift(PL_rsfp_filters, 1); av_store(PL_rsfp_filters, 0, datasv) ; return(datasv); @@ -2155,12 +2155,15 @@ void Perl_filter_del(pTHX_ filter_t funcp) { SV *datasv; - DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", (void*)funcp)); + +#ifdef DEBUGGING + DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", FPTR2DPTR(XPVIO *, funcp))); +#endif if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0) return; /* if filter is on top of stack (usual case) just pop it off */ datasv = FILTER_DATA(AvFILLp(PL_rsfp_filters)); - if (IoANY(datasv) == (void *)funcp) { + if (IoANY(datasv) == FPTR2DPTR(void *, funcp)) { IoFLAGS(datasv) &= ~IOf_FAKE_DIRP; IoANY(datasv) = (void *)NULL; sv_free(av_pop(PL_rsfp_filters)); @@ -2190,7 +2193,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) if (maxlen) { /* Want a block */ int len ; - int old_len = SvCUR(buf_sv) ; + const int old_len = SvCUR(buf_sv); /* ensure buf_sv is large enough */ SvGROW(buf_sv, (STRLEN)(old_len + maxlen)) ; @@ -2220,10 +2223,10 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */ } /* Get function pointer hidden within datasv */ - funcp = (filter_t)IoANY(datasv); + funcp = DPTR2FPTR(filter_t, IoANY(datasv)); DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_read %d: via function %p (%s)\n", - idx, (void*)funcp, SvPV_nolen(datasv))); + idx, 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 */ @@ -2269,7 +2272,7 @@ S_find_in_my_stash(pTHX_ const char *pkgname, I32 len) if ((gv = gv_fetchpv(pkgname, FALSE, SVt_PVCV))) { SV *sv; if (GvCV(gv) && (sv = cv_const_sv(GvCV(gv)))) { - pkgname = SvPV_nolen(sv); + pkgname = SvPV_nolen_const(sv); } } @@ -2366,11 +2369,9 @@ Perl_yylex(pTHX) #endif /* handle \E or end of string */ if (PL_bufptr == PL_bufend || PL_bufptr[1] == 'E') { - char oldmod; - /* if at a \E */ if (PL_lex_casemods) { - oldmod = PL_lex_casestack[--PL_lex_casemods]; + const char oldmod = PL_lex_casestack[--PL_lex_casemods]; PL_lex_casestack[PL_lex_casemods] = '\0'; if (PL_bufptr != PL_bufend @@ -2666,7 +2667,7 @@ Perl_yylex(pTHX) } PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr); PL_last_lop = PL_last_uni = Nullch; - sv_setpv(PL_linestr,""); + sv_setpvn(PL_linestr,"",0); TOKEN(';'); /* not infinite loop because rsfp is NULL now */ } /* If it looks like the start of a BOM or raw UTF-16, @@ -2707,7 +2708,7 @@ Perl_yylex(pTHX) if (PL_doextract) { /* Incest with pod. */ if (*s == '=' && strnEQ(s, "=cut", 4)) { - sv_setpv(PL_linestr, ""); + sv_setpvn(PL_linestr, "", 0); PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); PL_last_lop = PL_last_uni = Nullch; @@ -2773,8 +2774,8 @@ Perl_yylex(pTHX) else { STRLEN blen; STRLEN llen; - char *bstart = SvPV(CopFILESV(PL_curcop),blen); - char *lstart = SvPV(x,llen); + const char *bstart = SvPV_const(CopFILESV(PL_curcop),blen); + const char *lstart = SvPV_const(x,llen); if (llen < blen) { bstart += blen - llen; if (strnEQ(bstart, lstart, llen) && bstart[-1] == '/') { @@ -2820,7 +2821,7 @@ Perl_yylex(pTHX) * contains the start of the Perl program. */ if (d && *s != '#') { - char *c = ipath; + const char *c = ipath; while (*c && !strchr("; \t\r\n\f\v#", *c)) c++; if (c < d) @@ -2862,18 +2863,18 @@ Perl_yylex(pTHX) } #endif if (d) { - U32 oldpdb = PL_perldb; - bool oldn = PL_minus_n; - bool oldp = PL_minus_p; + const U32 oldpdb = PL_perldb; + const bool oldn = PL_minus_n; + const bool oldp = PL_minus_p; while (*d && !isSPACE(*d)) d++; while (SPACE_OR_TAB(*d)) d++; if (*d++ == '-') { - bool switches_done = PL_doswitches; + const bool switches_done = PL_doswitches; do { if (*d == 'M' || *d == 'm' || *d == 'C') { - char *m = d; + const char *m = d; while (*d && !isSPACE(*d)) d++; Perl_croak(aTHX_ "Too late for \"-%.*s\" option", (int)(d - m), m); @@ -2893,7 +2894,7 @@ Perl_yylex(pTHX) /* if we have already added "LINE: while (<>) {", we must not do it again */ { - sv_setpv(PL_linestr, ""); + sv_setpvn(PL_linestr, "", 0); PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); PL_last_lop = PL_last_uni = Nullch; @@ -3221,7 +3222,7 @@ Perl_yylex(pTHX) } tmp = (PL_expect == XOPERATOR ? '=' : '{'); /*'}(' for vi */ if (*s != ';' && *s != '}' && *s != tmp && (tmp != '=' || *s != ')')) { - char q = ((*s == '\'') ? '"' : '\''); + const char q = ((*s == '\'') ? '"' : '\''); /* If here for an expression, and parsed no attrs, back off. */ if (tmp == '=' && !attrs) { s = PL_bufptr; @@ -3313,7 +3314,7 @@ Perl_yylex(pTHX) while (d < PL_bufend && SPACE_OR_TAB(*d)) d++; if (*d == '}') { - char minus = (PL_tokenbuf[0] == '-'); + const char minus = (PL_tokenbuf[0] == '-'); s = force_word(s + minus, WORD, FALSE, TRUE, FALSE); if (minus) force_next('-'); @@ -3331,7 +3332,7 @@ Perl_yylex(pTHX) PL_expect = XSTATE; break; default: { - char *t; + const char *t; if (PL_oldoldbufptr == PL_last_lop) PL_lex_brackstack[PL_lex_brackets++] = XTERM; else @@ -3354,7 +3355,7 @@ Perl_yylex(pTHX) * eval"") we have to resolve the ambiguity. This code * covers the case where the first term in the curlies is a * quoted string. Most other cases need to be explicitly - * disambiguated by prepending a `+' before the opening + * disambiguated by prepending a "+" before the opening * curly in order to force resolution as an anon hash. * * XXX should probably propagate the outer expectation @@ -3377,7 +3378,7 @@ Perl_yylex(pTHX) && !isALNUM(*t)))) { /* skip q//-like construct */ - char *tmps; + const char *tmps; char open, close, term; I32 brackets = 1; @@ -3543,7 +3544,7 @@ Perl_yylex(pTHX) goto retry; } if (PL_lex_brackets < PL_lex_formbrack) { - char *t; + const char *t; #ifdef PERL_STRICT_CR for (t = s; SPACE_OR_TAB(*t); t++) ; #else @@ -3565,7 +3566,7 @@ Perl_yylex(pTHX) * warn on m:!=~\s+([/?]|[msy]\W|tr\W): */ if (*s == '~' && ckWARN(WARN_SYNTAX)) { - char *t = s+1; + const char *t = s+1; while (t < PL_bufend && isSPACE(*t)) ++t; @@ -3687,9 +3688,9 @@ Perl_yylex(pTHX) (t = strchr(s, '}')) && (t = strchr(t, '='))) { char tmpbuf[sizeof PL_tokenbuf]; - STRLEN len; for (t++; isSPACE(*t); t++) ; if (isIDFIRST_lazy_if(t,UTF)) { + STRLEN len; t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len); for (; isSPACE(*t); t++) ; if (*t == ';' && get_cv(tmpbuf, FALSE)) @@ -3702,7 +3703,7 @@ Perl_yylex(pTHX) PL_expect = XOPERATOR; if (PL_lex_state == LEX_NORMAL && isSPACE((char)tmp)) { - bool islop = (PL_last_lop == PL_oldoldbufptr); + const bool islop = (PL_last_lop == PL_oldoldbufptr); if (!islop || PL_last_lop_op == OP_GREPSTART) PL_expect = XOPERATOR; else if (strchr("$@\"'`q", *s)) @@ -3766,7 +3767,7 @@ Perl_yylex(pTHX) /* Warn about @ where they meant $. */ if (ckWARN(WARN_SYNTAX)) { if (*s == '[' || *s == '{') { - char *t = s + 1; + const char *t = s + 1; while (*t && (isALNUM_lazy_if(t,UTF) || strchr(" \t$#+-'\"", *t))) t++; if (*t == '}' || *t == ']') { @@ -3893,6 +3894,8 @@ Perl_yylex(pTHX) if (!s) missingterm((char*)0); yylval.ival = OP_CONST; + /* FIXME. I think that this can be const if char *d is replaced by + more localised variables. */ for (d = SvPV(PL_lex_stuff, len); len; len--, d++) { if (*d == '$' || *d == '@' || *d == '\\' || !UTF8_IS_INVARIANT((U8)*d)) { yylval.ival = OP_STRINGIFY; @@ -3925,9 +3928,7 @@ Perl_yylex(pTHX) case 'v': if (isDIGIT(s[1]) && PL_expect != XOPERATOR) { - char *start = s; - start++; - start++; + char *start = s + 2; while (isDIGIT(*start) || *start == '_') start++; if (*start == '.' && isDIGIT(start[1])) { @@ -3938,7 +3939,7 @@ Perl_yylex(pTHX) else if (!isALPHA(*start) && (PL_expect == XTERM || PL_expect == XREF || PL_expect == XSTATE || PL_expect == XTERMORDORDOR)) { - char c = *start; + const char c = *start; GV *gv; *start = '\0'; gv = gv_fetchpv(s, FALSE, SVt_PVCV); @@ -4094,7 +4095,7 @@ Perl_yylex(pTHX) just_a_word: { SV *sv; int pkgname = 0; - char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]); + const char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]); /* Get the rest if it looks like a package qualifier */ @@ -4161,7 +4162,7 @@ Perl_yylex(pTHX) yylval.opval->op_private = OPpCONST_BARE; /* UTF-8 package name? */ if (UTF && !IN_BYTES && - is_utf8_string((U8*)SvPVX(sv), SvCUR(sv))) + is_utf8_string((U8*)SvPVX_const(sv), SvCUR(sv))) SvUTF8_on(sv); /* And if "Foo::", then that's what it certainly is. */ @@ -4273,7 +4274,7 @@ Perl_yylex(pTHX) /* Is there a prototype? */ if (SvPOK(cv)) { STRLEN len; - char *proto = SvPV((SV*)cv, len); + const char *proto = SvPV_const((SV*)cv, len); if (!len) TERM(FUNC0SUB); if (*proto == '$' && proto[1] == '\0') @@ -4334,7 +4335,7 @@ Perl_yylex(pTHX) case KEY___PACKAGE__: yylval.opval = (OP*)newSVOP(OP_CONST, 0, (PL_curstash - ? newSVpv(HvNAME(PL_curstash), 0) + ? newSVhek(HvNAME_HEK(PL_curstash)) : &PL_sv_undef)); TERM(THING); @@ -4346,7 +4347,7 @@ Perl_yylex(pTHX) if (PL_rsfp && (!PL_in_eval || PL_tokenbuf[2] == 'D')) { const char *pname = "main"; if (PL_tokenbuf[2] == 'D') - pname = HvNAME(PL_curstash ? PL_curstash : PL_defstash); + pname = HvNAME_get(PL_curstash ? PL_curstash : PL_defstash); gv = gv_fetchpv(Perl_form(aTHX_ "%s::DATA", pname), TRUE, SVt_PVIO); GvMULTI_on(gv); if (!GvIO(gv)) @@ -4354,7 +4355,7 @@ Perl_yylex(pTHX) IoIFP(GvIOp(gv)) = PL_rsfp; #if defined(HAS_FCNTL) && defined(F_SETFD) { - int fd = PerlIO_fileno(PL_rsfp); + const int fd = PerlIO_fileno(PL_rsfp); fcntl(fd,F_SETFD,fd >= 3); } #endif @@ -4873,7 +4874,7 @@ Perl_yylex(pTHX) case KEY_open: s = skipspace(s); if (isIDFIRST_lazy_if(s,UTF)) { - char *t; + const char *t; for (d = s; isALNUM_lazy_if(d,UTF); d++) ; for (t=d; *t && isSPACE(*t); t++) ; if ( *t && strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE) @@ -4944,6 +4945,7 @@ Perl_yylex(pTHX) s = scan_str(s,FALSE,FALSE); if (!s) missingterm((char*)0); + PL_expect = XOPERATOR; force_next(')'); if (SvCUR(PL_lex_stuff)) { OP *words = Nullop; @@ -4953,7 +4955,7 @@ Perl_yylex(pTHX) SV *sv; for (; isSPACE(*d) && len; --len, ++d) ; if (len) { - char *b = d; + const char *b = d; if (!warned && ckWARN(WARN_QW)) { for (; !isSPACE(*d) && len; --len, ++d) { if (*d == ',') { @@ -5211,7 +5213,7 @@ Perl_yylex(pTHX) SSize_t tboffset = 0; expectation attrful; bool have_name, have_proto, bad_proto; - int key = tmp; + const int key = tmp; s = skipspace(s); @@ -5238,7 +5240,7 @@ Perl_yylex(pTHX) Perl_croak(aTHX_ "Missing name in \"my sub\""); PL_expect = XTERMBLOCK; attrful = XATTRTERM; - sv_setpv(PL_subname,"?"); + sv_setpvn(PL_subname,"?",1); have_name = FALSE; } @@ -5524,7 +5526,9 @@ S_pending_ident(pTHX) /* might be an "our" variable" */ if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) { /* build ops for a bareword */ - SV *sym = newSVpv(HvNAME(PAD_COMPNAME_OURSTASH(tmp)), 0); + HV *stash = PAD_COMPNAME_OURSTASH(tmp); + HEK *stashname = HvNAME_HEK(stash); + SV *sym = newSVhek(stashname); sv_catpvn(sym, "::", 2); sv_catpv(sym, PL_tokenbuf+1); yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym); @@ -5595,7 +5599,7 @@ S_pending_ident(pTHX) */ I32 -Perl_keyword (pTHX_ char *name, I32 len) +Perl_keyword (pTHX_ const char *name, I32 len) { switch (len) { @@ -8893,9 +8897,9 @@ unknown: } STATIC void -S_checkcomma(pTHX_ register char *s, char *name, const char *what) +S_checkcomma(pTHX_ register char *s, const char *name, const char *what) { - char *w; + const char *w; if (*s == ' ' && s[1] == '(') { /* XXX gotta be a better way */ if (ckWARN(WARN_SYNTAX)) { @@ -8927,7 +8931,7 @@ S_checkcomma(pTHX_ register char *s, char *name, const char *what) s++; if (*s == ',') { int kw; - *s = '\0'; + *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) @@ -8973,7 +8977,7 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, SV *sv, SV *pv, msg = Perl_newSVpvf(aTHX_ "Constant(%s): %s%s%s", (type ? type: "undef"), why1, why2, why3); msgdone: - yyerror(SvPVX(msg)); + yyerror(SvPVX_const(msg)); SvREFCNT_dec(msg); return sv; } @@ -9011,9 +9015,8 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, SV *sv, SV *pv, /* Check the eval first */ if (!PL_in_eval && SvTRUE(ERRSV)) { - STRLEN n_a; sv_catpv(ERRSV, "Propagated"); - yyerror(SvPV(ERRSV, n_a)); /* Duplicates the message inside eval */ + yyerror(SvPV_nolen_const(ERRSV)); /* Duplicates the message inside eval */ (void)POPs; res = SvREFCNT_inc(sv); } @@ -9079,7 +9082,7 @@ S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_packag } STATIC char * -S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN destlen, I32 ck_uni) +S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRLEN destlen, I32 ck_uni) { register char *d; register char *e; @@ -9154,7 +9157,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des if (bracket) { if (isSPACE(s[-1])) { while (s < send) { - char ch = *s++; + const char ch = *s++; if (!SPACE_OR_TAB(ch)) { *d = ch; break; @@ -9258,9 +9261,8 @@ STATIC char * S_scan_pat(pTHX_ char *start, I32 type) { PMOP *pm; - char *s; + char *s = scan_str(start,FALSE,FALSE); - s = scan_str(start,FALSE,FALSE); if (!s) Perl_croak(aTHX_ "Search pattern not terminated"); @@ -9431,7 +9433,7 @@ S_scan_heredoc(pTHX_ register char *s) register char *d; register char *e; char *peek; - int outer = (PL_rsfp && !(PL_lex_inwhat == OP_SCALAR)); + const int outer = (PL_rsfp && !(PL_lex_inwhat == OP_SCALAR)); s += 2; d = PL_tokenbuf; @@ -9467,7 +9469,7 @@ S_scan_heredoc(pTHX_ register char *s) #ifndef PERL_STRICT_CR d = strchr(s, '\r'); if (d) { - char *olds = s; + char * const olds = s; s = d; while (s < PL_bufend) { if (*s == '\r') { @@ -9484,7 +9486,7 @@ S_scan_heredoc(pTHX_ register char *s) } *d = '\0'; PL_bufend = d; - SvCUR_set(PL_linestr, PL_bufend - SvPVX(PL_linestr)); + SvCUR_set(PL_linestr, PL_bufend - SvPVX_const(PL_linestr)); s = olds; } #endif @@ -9515,7 +9517,7 @@ S_scan_heredoc(pTHX_ register char *s) if (PL_lex_inwhat == OP_SUBST && PL_in_eval && !PL_rsfp) { char *bufptr = PL_sublex_info.super_bufptr; char *bufend = PL_sublex_info.super_bufend; - char *olds = s - SvCUR(herewas); + char * const olds = s - SvCUR(herewas); s = strchr(bufptr, '\n'); if (!s) s = bufend; @@ -9533,7 +9535,7 @@ S_scan_heredoc(pTHX_ register char *s) sv_setpvn(tmpstr,d+1,s-d); s += len - 1; sv_catpvn(herewas,s,bufend-s); - Copy(SvPVX(herewas),bufptr,SvCUR(herewas) + 1,char); + Copy(SvPVX_const(herewas),bufptr,SvCUR(herewas) + 1,char); s = olds; goto retval; @@ -9577,7 +9579,7 @@ S_scan_heredoc(pTHX_ register char *s) { PL_bufend[-2] = '\n'; PL_bufend--; - SvCUR_set(PL_linestr, PL_bufend - SvPVX(PL_linestr)); + SvCUR_set(PL_linestr, PL_bufend - SvPVX_const(PL_linestr)); } else if (PL_bufend[-1] == '\r') PL_bufend[-1] = '\n'; @@ -9595,7 +9597,7 @@ S_scan_heredoc(pTHX_ register char *s) av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop),sv); } if (*s == term && memEQ(s,PL_tokenbuf,len)) { - STRLEN off = PL_bufend - 1 - SvPVX(PL_linestr); + STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr); *(SvPVX(PL_linestr) + off ) = ' '; sv_catsv(PL_linestr,herewas); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); @@ -9614,7 +9616,7 @@ retval: } SvREFCNT_dec(herewas); if (!IN_BYTES) { - if (UTF && is_utf8_string((U8*)SvPVX(tmpstr), SvCUR(tmpstr))) + if (UTF && is_utf8_string((U8*)SvPVX_const(tmpstr), SvCUR(tmpstr))) SvUTF8_on(tmpstr); else if (PL_encoding) sv_recode_to_utf8(tmpstr, PL_encoding); @@ -9645,7 +9647,7 @@ S_scan_inputsymbol(pTHX_ char *start) { register char *s = start; /* current position in buffer */ register char *d; - register char *e; + const char *e; char *end; I32 len; @@ -9725,8 +9727,9 @@ S_scan_inputsymbol(pTHX_ char *start) */ if ((tmp = pad_findmy(d)) != NOT_IN_PAD) { if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) { - SV *sym = sv_2mortal( - newSVpv(HvNAME(PAD_COMPNAME_OURSTASH(tmp)),0)); + HV *stash = PAD_COMPNAME_OURSTASH(tmp); + HEK *stashname = HvNAME_HEK(stash); + SV *sym = sv_2mortal(newSVhek(stashname)); sv_catpvn(sym, "::", 2); sv_catpv(sym, d+1); d = SvPVX(sym); @@ -9888,10 +9891,10 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) bool cont = TRUE; while (cont) { - int offset = s - SvPVX(PL_linestr); - bool found = sv_cat_decode(sv, PL_encoding, PL_linestr, + int offset = s - SvPVX_const(PL_linestr); + const bool found = sv_cat_decode(sv, PL_encoding, PL_linestr, &offset, (char*)termstr, termlen); - char *ns = SvPVX(PL_linestr) + offset; + const char *ns = SvPVX_const(PL_linestr) + offset; char *svlast = SvEND(sv) - 1; for (; s < ns; s++) { @@ -9903,8 +9906,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) else { /* handle quoted delimiters */ if (SvCUR(sv) > 1 && *(svlast-1) == '\\') { - char *t; - for (t = svlast-2; t >= SvPVX(sv) && *t == '\\';) + const char *t; + for (t = svlast-2; t >= SvPVX_const(sv) && *t == '\\';) t--; if ((svlast-1 - t) % 2) { if (!keep_quoted) { @@ -9919,10 +9922,11 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) cont = FALSE; } else { - char *t, *w; + const char *t; + char *w; if (!last) last = SvPVX(sv); - for (w = t = last; t < svlast; w++, t++) { + for (t = w = last; t < svlast; w++, t++) { /* At here, all closes are "was quoted" one, so we don't check PL_multi_close. */ if (*t == '\\') { @@ -9939,7 +9943,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) if (w < t) { *w++ = term; *w = '\0'; - SvCUR_set(sv, w - SvPVX(sv)); + SvCUR_set(sv, w - SvPVX_const(sv)); } last = w; if (--brackets <= 0) @@ -10017,7 +10021,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) } /* terminate the copied string and update the sv's end-of-string */ *to = '\0'; - SvCUR_set(sv, to - SvPVX(sv)); + SvCUR_set(sv, to - SvPVX_const(sv)); /* * this next chunk reads more into the buffer if we're not done yet @@ -10027,18 +10031,18 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) break; /* handle case where we are done yet :-) */ #ifndef PERL_STRICT_CR - if (to - SvPVX(sv) >= 2) { + if (to - SvPVX_const(sv) >= 2) { if ((to[-2] == '\r' && to[-1] == '\n') || (to[-2] == '\n' && to[-1] == '\r')) { to[-2] = '\n'; to--; - SvCUR_set(sv, to - SvPVX(sv)); + SvCUR_set(sv, to - SvPVX_const(sv)); } else if (to[-1] == '\r') to[-1] = '\n'; } - else if (to - SvPVX(sv) == 1 && to[-1] == '\r') + else if (to - SvPVX_const(sv) == 1 && to[-1] == '\r') to[-1] = '\n'; #endif @@ -10555,7 +10559,7 @@ S_scan_formline(pTHX_ register char *s) else break; } - s = eol; + s = (char*)eol; if (PL_rsfp) { s = filter_gets(PL_linestr, PL_rsfp, 0); PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr); @@ -10579,7 +10583,7 @@ S_scan_formline(pTHX_ register char *s) else PL_lex_state = LEX_FORMLINE; if (!IN_BYTES) { - if (UTF && is_utf8_string((U8*)SvPVX(stuff), SvCUR(stuff))) + if (UTF && is_utf8_string((U8*)SvPVX_const(stuff), SvCUR(stuff))) SvUTF8_on(stuff); else if (PL_encoding) sv_recode_to_utf8(stuff, PL_encoding); @@ -10610,7 +10614,7 @@ S_set_csh(pTHX) I32 Perl_start_subparse(pTHX_ I32 is_format, U32 flags) { - I32 oldsavestack_ix = PL_savestack_ix; + const I32 oldsavestack_ix = PL_savestack_ix; CV* outsidecv = PL_compcv; if (PL_compcv) { @@ -10654,8 +10658,9 @@ Perl_yyerror(pTHX_ const char *s) if (!yychar || (yychar == ';' && !PL_rsfp)) where = "at EOF"; - else if (PL_bufptr > PL_oldoldbufptr && PL_bufptr - PL_oldoldbufptr < 200 && - PL_oldoldbufptr != PL_oldbufptr && PL_oldbufptr != PL_bufptr) { + else if (PL_oldoldbufptr && PL_bufptr > PL_oldoldbufptr && + PL_bufptr - PL_oldoldbufptr < 200 && PL_oldoldbufptr != PL_oldbufptr && + PL_oldbufptr != PL_bufptr) { /* Only for NetWare: The code below is removed for NetWare because it abends/crashes on NetWare @@ -10670,8 +10675,8 @@ Perl_yyerror(pTHX_ const char *s) context = PL_oldoldbufptr; contlen = PL_bufptr - PL_oldoldbufptr; } - else if (PL_bufptr > PL_oldbufptr && PL_bufptr - PL_oldbufptr < 200 && - PL_oldbufptr != PL_bufptr) { + else if (PL_oldbufptr && PL_bufptr > PL_oldbufptr && + PL_bufptr - PL_oldbufptr < 200 && PL_oldbufptr != PL_bufptr) { /* Only for NetWare: The code below is removed for NetWare because it abends/crashes on NetWare @@ -10705,7 +10710,7 @@ Perl_yyerror(pTHX_ const char *s) Perl_sv_catpvf(aTHX_ where_sv, "%c", yychar); else Perl_sv_catpvf(aTHX_ where_sv, "\\%03o", yychar & 255); - where = SvPVX(where_sv); + where = SvPVX_const(where_sv); } msg = sv_2mortal(newSVpv(s, 0)); Perl_sv_catpvf(aTHX_ msg, " at %s line %"IVdf", ", @@ -10743,8 +10748,7 @@ Perl_yyerror(pTHX_ const char *s) STATIC char* S_swallow_bom(pTHX_ U8 *s) { - STRLEN slen; - slen = SvCUR(PL_linestr); + const STRLEN slen = SvCUR(PL_linestr); switch (s[0]) { case 0xFF: if (s[1] == 0xFE) { @@ -10856,8 +10860,8 @@ restore_rsfp(pTHX_ void *f) static I32 utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) { - STRLEN old = SvCUR(sv); - I32 count = FILTER_READ(idx+1, sv, maxlen); + const STRLEN old = SvCUR(sv); + 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)); @@ -10865,8 +10869,8 @@ utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) U8* tmps; I32 newlen; New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8); - Copy(SvPVX(sv), tmps, old, char); - utf16_to_utf8((U8*)SvPVX(sv) + old, tmps + old, + Copy(SvPVX_const(sv), tmps, old, char); + utf16_to_utf8((U8*)SvPVX_const(sv) + old, tmps + old, SvCUR(sv) - old, &newlen); sv_usepvn(sv, (char*)tmps, (STRLEN)newlen + old); } @@ -10877,8 +10881,8 @@ utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen) { - STRLEN old = SvCUR(sv); - I32 count = FILTER_READ(idx+1, sv, maxlen); + const STRLEN old = SvCUR(sv); + 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)); @@ -10886,8 +10890,8 @@ utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen) U8* tmps; I32 newlen; New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8); - Copy(SvPVX(sv), tmps, old, char); - utf16_to_utf8((U8*)SvPVX(sv) + old, tmps + old, + Copy(SvPVX_const(sv), tmps, old, char); + utf16_to_utf8((U8*)SvPVX_const(sv) + old, tmps + old, SvCUR(sv) - old, &newlen); sv_usepvn(sv, (char*)tmps, (STRLEN)newlen + old); } @@ -10989,5 +10993,5 @@ Perl_scan_vstring(pTHX_ const char *s, SV *sv) * indent-tabs-mode: t * End: * - * vim: shiftwidth=4: -*/ + * ex: set ts=8 sts=4 sw=4 noet: + */