X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/0bfa2a8afc04ca8a47987d5890bbbe751faf4444..a0714e2c8319bd04d1f7d262de652b6b5ec054f7:/toke.c diff --git a/toke.c b/toke.c index 13fd766..8f01720 100644 --- a/toke.c +++ b/toke.c @@ -1,7 +1,7 @@ /* toke.c * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others + * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -27,6 +27,7 @@ #define yylval (*PL_yylvalp) static const char ident_too_long[] = "Identifier too long"; +static const char commaless_variable_list[] = "comma-less variable list"; static void restore_rsfp(pTHX_ void *f); #ifndef PERL_NO_UTF16_FILTER @@ -206,8 +207,11 @@ enum token_type { TOKENTYPE_GVVAL }; -static struct debug_tokens { const int token, type; const char *name; } - const debug_tokens[] = +static struct debug_tokens { + const int token; + enum token_type type; + const char *name; +} const debug_tokens[] = { { ADDOP, TOKENTYPE_OPNUM, "ADDOP" }, { ANDAND, TOKENTYPE_NONE, "ANDAND" }, @@ -282,11 +286,12 @@ static struct debug_tokens { const int token, type; const char *name; } STATIC int S_tokereport(pTHX_ I32 rv) { + dVAR; if (DEBUG_T_TEST) { - const char *name = Nullch; + const char *name = NULL; enum token_type type = TOKENTYPE_NONE; const struct debug_tokens *p; - SV* const report = newSVpvn("<== ", 4); + SV* const report = newSVpvs("<== "); for (p = debug_tokens; p->token; p++) { if (p->token == (int)rv) { @@ -300,7 +305,7 @@ S_tokereport(pTHX_ I32 rv) else if ((char)rv > ' ' && (char)rv < '~') Perl_sv_catpvf(aTHX_ report, "'%c'", (char)rv); else if (!rv) - Perl_sv_catpv(aTHX_ report, "EOF"); + sv_catpvs(report, "EOF"); else Perl_sv_catpvf(aTHX_ report, "?? %"IVdf, (IV)rv); switch (type) { @@ -328,7 +333,7 @@ S_tokereport(pTHX_ I32 rv) } else - Perl_sv_catpv(aTHX_ report, "(opval=null)"); + sv_catpvs(report, "(opval=null)"); break; } PerlIO_printf(Perl_debug_log, "### %s\n\n", SvPV_nolen_const(report)); @@ -342,7 +347,7 @@ S_tokereport(pTHX_ I32 rv) STATIC void S_printbuf(pTHX_ const char* fmt, const char* s) { - SV* const tmp = newSVpvn("", 0); + SV* const tmp = newSVpvs(""); PerlIO_printf(Perl_debug_log, fmt, pv_display(tmp, s, strlen(s), 0, 60)); SvREFCNT_dec(tmp); } @@ -359,6 +364,7 @@ S_printbuf(pTHX_ const char* fmt, const char* s) STATIC int S_ao(pTHX_ int toketype) { + dVAR; if (*PL_bufptr == '=') { PL_bufptr++; if (toketype == ANDAND) @@ -388,6 +394,7 @@ S_ao(pTHX_ int toketype) STATIC void S_no_op(pTHX_ const char *what, char *s) { + dVAR; char * const oldbp = PL_bufptr; const bool is_first = (PL_oldbufptr == PL_linestart); @@ -429,6 +436,7 @@ S_no_op(pTHX_ const char *what, char *s) STATIC void S_missingterm(pTHX_ char *s) { + dVAR; char tmpbuf[3]; char q; if (s) { @@ -457,9 +465,9 @@ S_missingterm(pTHX_ char *s) Perl_croak(aTHX_ "Can't find string terminator %c%s%c anywhere before EOF",q,s,q); } -#define FEATURE_IS_ENABLED(name, namelen) \ +#define FEATURE_IS_ENABLED(name) \ ((0 != (PL_hints & HINT_LOCALIZE_HH)) \ - && feature_is_enabled(name, namelen)) + && S_feature_is_enabled(aTHX_ STR_WITH_LEN(name))) /* * S_feature_is_enabled * Check whether the named feature is enabled. @@ -467,6 +475,7 @@ S_missingterm(pTHX_ char *s) STATIC bool S_feature_is_enabled(pTHX_ char *name, STRLEN namelen) { + dVAR; HV * const hinthv = GvHV(PL_hintgv); char he_name[32] = "feature_"; (void) strncpy(&he_name[8], name, 24); @@ -502,17 +511,6 @@ Perl_deprecate_old(pTHX_ const char *s) } /* - * depcom - * Deprecate a comma-less variable list. - */ - -STATIC void -S_depcom(pTHX) -{ - deprecate_old("comma-less variable list"); -} - -/* * experimental text filters for win32 carriage-returns, utf16-to-utf8 and * utf16-to-utf8-reversed. */ @@ -559,6 +557,7 @@ S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen) void Perl_lex_start(pTHX_ SV *line) { + dVAR; const char *s; STRLEN len; @@ -606,8 +605,8 @@ Perl_lex_start(pTHX_ SV *line) *PL_lex_casestack = '\0'; PL_lex_dojoin = 0; PL_lex_starts = 0; - PL_lex_stuff = Nullsv; - PL_lex_repl = Nullsv; + PL_lex_stuff = NULL; + PL_lex_repl = NULL; PL_lex_inpat = 0; PL_nexttoke = 0; PL_lex_inwhat = 0; @@ -619,12 +618,12 @@ Perl_lex_start(pTHX_ SV *line) if (!len || s[len-1] != ';') { if (!(SvFLAGS(PL_linestr) & SVs_TEMP)) PL_linestr = sv_2mortal(newSVsv(PL_linestr)); - sv_catpvn(PL_linestr, "\n;", 2); + sv_catpvs(PL_linestr, "\n;"); } SvTEMP_off(PL_linestr); PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr); PL_bufend = PL_bufptr + SvCUR(PL_linestr); - PL_last_lop = PL_last_uni = Nullch; + PL_last_lop = PL_last_uni = NULL; PL_rsfp = 0; } @@ -637,6 +636,7 @@ Perl_lex_start(pTHX_ SV *line) void Perl_lex_end(pTHX) { + dVAR; PL_doextract = FALSE; } @@ -653,6 +653,7 @@ Perl_lex_end(pTHX) STATIC void S_incline(pTHX_ char *s) { + dVAR; char *t; char *n; char *e; @@ -747,6 +748,7 @@ S_incline(pTHX_ char *s) STATIC char * S_skipspace(pTHX_ register char *s) { + dVAR; if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) { while (s < PL_bufend && SPACE_OR_TAB(*s)) s++; @@ -784,7 +786,7 @@ S_skipspace(pTHX_ register char *s) /* try to recharge the buffer */ if ((s = filter_gets(PL_linestr, PL_rsfp, - (prevlen = SvCUR(PL_linestr)))) == Nullch) + (prevlen = SvCUR(PL_linestr)))) == NULL) { /* end of file. Add on the -p or -n magic */ if (PL_minus_p) { @@ -803,7 +805,7 @@ S_skipspace(pTHX_ register char *s) PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); - PL_last_lop = PL_last_uni = Nullch; + PL_last_lop = PL_last_uni = NULL; /* Close the filehandle. Could be from -P preprocessor, * STDIN, or a regular file. If we were reading code from @@ -845,13 +847,13 @@ S_skipspace(pTHX_ register char *s) * so store the line into the debugger's array of lines */ if (PERLDB_LINE && PL_curstash != PL_debstash) { - SV * const sv = NEWSV(85,0); + SV * const sv = newSV(0); sv_upgrade(sv, SVt_PVMG); sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr); (void)SvIOK_on(sv); SvIV_set(sv, 0); - av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv); + av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv); } } } @@ -868,6 +870,7 @@ S_skipspace(pTHX_ register char *s) STATIC void S_check_uni(pTHX) { + dVAR; char *s; char *t; @@ -878,6 +881,9 @@ S_check_uni(pTHX) for (s = PL_last_uni; 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'; @@ -906,6 +912,7 @@ S_check_uni(pTHX) STATIC I32 S_lop(pTHX_ I32 f, int x, char *s) { + dVAR; yylval.ival = f; CLINE; PL_expect = x; @@ -935,6 +942,7 @@ S_lop(pTHX_ I32 f, int x, char *s) STATIC void S_force_next(pTHX_ I32 type) { + dVAR; PL_nexttype[PL_nexttoke] = type; PL_nexttoke++; if (PL_lex_state != LEX_KNOWNEXT) { @@ -947,6 +955,7 @@ S_force_next(pTHX_ I32 type) STATIC SV * S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len) { + dVAR; SV * const sv = newSVpvn(start,len); if (UTF && !IN_BYTES && is_utf8_string((const U8*)start, len)) SvUTF8_on(sv); @@ -972,6 +981,7 @@ S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len) STATIC char * S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick) { + dVAR; register char *s; STRLEN len; @@ -1013,8 +1023,10 @@ S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow STATIC void S_force_ident(pTHX_ register const char *s, int kind) { + dVAR; if (s && *s) { - OP* const o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0)); + const STRLEN len = strlen(s); + OP* const o = (OP*)newSVOP(OP_CONST, 0, newSVpvn(s, len)); PL_nextval[PL_nexttoke].opval = o; force_next(WORD); if (kind) { @@ -1022,12 +1034,14 @@ S_force_ident(pTHX_ register const char *s, int kind) /* XXX see note in pp_entereval() for why we forgo typo warnings if the symbol must be introduced in an eval. GSAR 96-10-12 */ - gv_fetchpv(s, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : TRUE, - kind == '$' ? SVt_PV : - kind == '@' ? SVt_PVAV : - kind == '%' ? SVt_PVHV : + gv_fetchpvn_flags(s, len, + PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) + : GV_ADD, + kind == '$' ? SVt_PV : + kind == '@' ? SVt_PVAV : + kind == '%' ? SVt_PVHV : SVt_PVGV - ); + ); } } } @@ -1068,6 +1082,7 @@ Perl_str_to_version(pTHX_ SV *sv) STATIC char * S_force_version(pTHX_ char *s, int guessing) { + dVAR; OP *version = Nullop; char *d; @@ -1112,6 +1127,7 @@ S_force_version(pTHX_ char *s, int guessing) STATIC SV * S_tokeq(pTHX_ SV *sv) { + dVAR; register char *s; register char *send; register char *d; @@ -1185,6 +1201,7 @@ S_tokeq(pTHX_ SV *sv) STATIC I32 S_sublex_start(pTHX) { + dVAR; register const I32 op_type = yylval.ival; if (op_type == OP_NULL) { @@ -1206,7 +1223,7 @@ S_sublex_start(pTHX) sv = nsv; } yylval.opval = (OP*)newSVOP(op_type, 0, sv); - PL_lex_stuff = Nullsv; + PL_lex_stuff = NULL; /* Allow // "foo" */ if (op_type == OP_READLINE) PL_expect = XTERMORDORDOR; @@ -1263,12 +1280,12 @@ S_sublex_push(pTHX) SAVEGENERICPV(PL_lex_casestack); PL_linestr = PL_lex_stuff; - PL_lex_stuff = Nullsv; + PL_lex_stuff = NULL; PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr); PL_bufend += SvCUR(PL_linestr); - PL_last_lop = PL_last_uni = Nullch; + PL_last_lop = PL_last_uni = NULL; SAVEFREESV(PL_linestr); PL_lex_dojoin = FALSE; @@ -1300,7 +1317,7 @@ S_sublex_done(pTHX) { dVAR; if (!PL_lex_starts++) { - SV * const sv = newSVpvn("",0); + SV * const sv = newSVpvs(""); if (SvUTF8(PL_linestr)) SvUTF8_on(sv); PL_expect = XOPERATOR; @@ -1319,7 +1336,7 @@ S_sublex_done(pTHX) PL_lex_inpat = 0; PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr); PL_bufend += SvCUR(PL_linestr); - PL_last_lop = PL_last_uni = Nullch; + PL_last_lop = PL_last_uni = NULL; SAVEFREESV(PL_linestr); PL_lex_dojoin = FALSE; PL_lex_brackets = 0; @@ -1336,7 +1353,7 @@ S_sublex_done(pTHX) } else { PL_lex_state = LEX_INTERPCONCAT; - PL_lex_repl = Nullsv; + PL_lex_repl = NULL; } return ','; } @@ -1426,8 +1443,9 @@ S_sublex_done(pTHX) STATIC char * S_scan_const(pTHX_ char *start) { + dVAR; register char *send = PL_bufend; /* end of the constant */ - SV *sv = NEWSV(93, send - start); /* sv for the constant */ + SV *sv = newSV(send - start); /* sv for the constant */ register char *s = start; /* start of the constant */ register char *d = SvPVX(sv); /* destination for copies */ bool dorange = FALSE; /* are we in a translit range? */ @@ -1770,8 +1788,8 @@ S_scan_const(pTHX_ char *start) goto NUM_ESCAPE_INSERT; } res = newSVpvn(s + 1, e - s - 1); - res = new_constant( Nullch, 0, "charnames", - res, Nullsv, "\\N{...}" ); + res = new_constant( NULL, 0, "charnames", + res, NULL, "\\N{...}" ); if (has_utf8) sv_utf8_upgrade(res); str = SvPV_const(res,len); @@ -1920,7 +1938,7 @@ S_scan_const(pTHX_ char *start) if (s > PL_bufptr) { if ( PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) ) sv = new_constant(start, s - start, (PL_lex_inpat ? "qr" : "q"), - sv, Nullsv, + sv, NULL, ( PL_lex_inwhat == OP_TRANS ? "tr" : ( (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat) @@ -1956,6 +1974,7 @@ S_scan_const(pTHX_ char *start) STATIC int S_intuit_more(pTHX_ register char *s) { + dVAR; if (PL_lex_brackets) return TRUE; if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{')) @@ -2018,8 +2037,10 @@ S_intuit_more(pTHX_ register char *s) case '$': weight -= seen[un_char] * 10; if (isALNUM_lazy_if(s+1,UTF)) { + int len; scan_ident(s, send, tmpbuf, sizeof tmpbuf, FALSE); - if ((int)strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE, SVt_PV)) + len = (int)strlen(tmpbuf); + if (len > 1 && gv_fetchpvn_flags(tmpbuf, len, 0, SVt_PV)) weight -= 100; else weight -= 10; @@ -2108,24 +2129,26 @@ S_intuit_more(pTHX_ register char *s) */ STATIC int -S_intuit_method(pTHX_ char *start, GV *gv) +S_intuit_method(pTHX_ char *start, GV *gv, CV *cv) { + dVAR; char *s = start + (*start == '$'); char tmpbuf[sizeof PL_tokenbuf]; STRLEN len; GV* indirgv; if (gv) { - CV *cv; - if (GvIO(gv)) + if (SvTYPE(gv) == SVt_PVGV && GvIO(gv)) return 0; - if ((cv = GvCVu(gv))) { - const char *proto = SvPVX_const(cv); - if (proto) { - if (*proto == ';') - proto++; - if (*proto == '*') - return 0; + if (cv) { + if (SvPOK(cv)) { + const char *proto = SvPVX_const(cv); + if (proto) { + if (*proto == ';') + proto++; + if (*proto == '*') + return 0; + } } } else gv = 0; @@ -2150,7 +2173,7 @@ S_intuit_method(pTHX_ char *start, GV *gv) tmpbuf[len] = '\0'; goto bare_package; } - indirgv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV); + indirgv = gv_fetchpvn_flags(tmpbuf, len, 0, SVt_PVCV); if (indirgv && GvCVu(indirgv)) return 0; /* filehandle or package name makes it a method */ @@ -2181,6 +2204,7 @@ S_intuit_method(pTHX_ char *start, GV *gv) STATIC const char* S_incl_perldb(pTHX) { + dVAR; if (PL_perldb) { const char * const pdb = PerlEnv_getenv("PERL5DB"); @@ -2213,13 +2237,14 @@ S_incl_perldb(pTHX) SV * Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) { + dVAR; if (!funcp) - return Nullsv; + return NULL; if (!PL_rsfp_filters) PL_rsfp_filters = newAV(); if (!datasv) - datasv = NEWSV(255,0); + datasv = newSV(0); SvUPGRADE(datasv, SVt_PVIO); IoANY(datasv) = FPTR2DPTR(void *, funcp); /* stash funcp into spare field */ IoFLAGS(datasv) |= IOf_FAKE_DIRP; @@ -2235,6 +2260,7 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) void Perl_filter_del(pTHX_ filter_t funcp) { + dVAR; SV *datasv; #ifdef DEBUGGING @@ -2261,6 +2287,7 @@ Perl_filter_del(pTHX_ filter_t funcp) I32 Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) { + dVAR; filter_t funcp; SV *datasv = NULL; @@ -2317,6 +2344,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) STATIC char * S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append) { + dVAR; #ifdef PERL_CR_FILTER if (!PL_rsfp_filters) { filter_add(S_cr_textfilter,NULL); @@ -2328,7 +2356,7 @@ S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append) if (FILTER_READ(0, sv, 0) > 0) return ( SvPVX(sv) ) ; else - return Nullch ; + return NULL ; } else return (sv_gets(sv, fp, append)); @@ -2337,6 +2365,7 @@ S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append) STATIC HV * S_find_in_my_stash(pTHX_ const char *pkgname, I32 len) { + dVAR; GV *gv; if (len == 11 && *pkgname == '_' && strEQ(pkgname, "__PACKAGE__")) @@ -2344,13 +2373,13 @@ S_find_in_my_stash(pTHX_ const char *pkgname, I32 len) if (len > 2 && (pkgname[len - 2] == ':' && pkgname[len - 1] == ':') && - (gv = gv_fetchpv(pkgname, FALSE, SVt_PVHV))) + (gv = gv_fetchpvn_flags(pkgname, len, 0, SVt_PVHV))) { return GvHV(gv); /* Foo:: */ } /* use constant CLASS => 'MyClass' */ - if ((gv = gv_fetchpv(pkgname, FALSE, SVt_PVCV))) { + if ((gv = gv_fetchpvn_flags(pkgname, len, 0, SVt_PVCV))) { SV *sv; if (GvCV(gv) && (sv = cv_const_sv(GvCV(gv)))) { pkgname = SvPV_nolen_const(sv); @@ -2362,6 +2391,7 @@ S_find_in_my_stash(pTHX_ const char *pkgname, I32 len) STATIC char * S_tokenize_use(pTHX_ int is_use, char *s) { + dVAR; if (PL_expect != XSTATE) yyerror(Perl_form(aTHX_ "\"%s\" not allowed in expression", is_use ? "use" : "no")); @@ -2423,13 +2453,14 @@ S_tokenize_use(pTHX_ int is_use, char *s) { int Perl_yylex(pTHX) { + dVAR; register char *s = PL_bufptr; register char *d; STRLEN len; bool bof = FALSE; DEBUG_T( { - SV* tmp = newSVpvn("", 0); + SV* tmp = newSVpvs(""); PerlIO_printf(Perl_debug_log, "### %"IVdf":LEX_%s/X%s %s\n", (IV)CopLINE(PL_curcop), lex_state_names[PL_lex_state], @@ -2591,7 +2622,7 @@ Perl_yylex(pTHX) { if (PL_bufptr != PL_bufend) Perl_croak(aTHX_ "Bad evalled substitution pattern"); - PL_lex_repl = Nullsv; + PL_lex_repl = NULL; } /* FALLTHROUGH */ case LEX_INTERPCONCAT: @@ -2680,21 +2711,21 @@ Perl_yylex(pTHX) PL_preambled = TRUE; sv_setpv(PL_linestr,incl_perldb()); if (SvCUR(PL_linestr)) - sv_catpvn(PL_linestr,";", 1); + sv_catpvs(PL_linestr,";"); if (PL_preambleav){ while(AvFILLp(PL_preambleav) >= 0) { SV *tmpsv = av_shift(PL_preambleav); sv_catsv(PL_linestr, tmpsv); - sv_catpvn(PL_linestr, ";", 1); + sv_catpvs(PL_linestr, ";"); sv_free(tmpsv); } sv_free((SV*)PL_preambleav); PL_preambleav = NULL; } if (PL_minus_n || PL_minus_p) { - sv_catpv(PL_linestr, "LINE: while (<>) {"); + sv_catpvs(PL_linestr, "LINE: while (<>) {"); if (PL_minus_l) - sv_catpv(PL_linestr,"chomp;"); + sv_catpvs(PL_linestr,"chomp;"); if (PL_minus_a) { if (PL_minus_F) { if ((*PL_splitstr == '/' || *PL_splitstr == '\'' @@ -2704,11 +2735,8 @@ Perl_yylex(pTHX) else { /* "q\0${splitstr}\0" is legal perl. Yes, even NUL bytes can be used as quoting characters. :-) */ - /* The count here deliberately includes the NUL - that terminates the C string constant. This - embeds the opening NUL into the string. */ const char *splits = PL_splitstr; - sv_catpvn(PL_linestr, "our @F=split(q", 15); + sv_catpvs(PL_linestr, "our @F=split(q\0"); do { /* Need to \ \s */ if (*splits == '\\') @@ -2718,31 +2746,33 @@ Perl_yylex(pTHX) /* This loop will embed the trailing NUL of PL_linestr as the last thing it does before terminating. */ - sv_catpvn(PL_linestr, ");", 2); + sv_catpvs(PL_linestr, ");"); } } else - sv_catpv(PL_linestr,"our @F=split(' ');"); + sv_catpvs(PL_linestr,"our @F=split(' ');"); } } - sv_catpvn(PL_linestr, "\n", 1); + if (PL_minus_E) + sv_catpvs(PL_linestr,"use feature ':5.10';"); + sv_catpvs(PL_linestr, "\n"); 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; + PL_last_lop = PL_last_uni = NULL; if (PERLDB_LINE && PL_curstash != PL_debstash) { - SV * const sv = NEWSV(85,0); + SV * const sv = newSV(0); sv_upgrade(sv, SVt_PVMG); sv_setsv(sv,PL_linestr); (void)SvIOK_on(sv); SvIV_set(sv, 0); - av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv); + av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv); } goto retry; } do { bof = PL_rsfp ? TRUE : FALSE; - if ((s = filter_gets(PL_linestr, PL_rsfp, 0)) == Nullch) { + if ((s = filter_gets(PL_linestr, PL_rsfp, 0)) == NULL) { fake_eof: if (PL_rsfp) { if (PL_preprocess && !PL_in_eval) @@ -2759,12 +2789,12 @@ Perl_yylex(pTHX) ? ";}continue{print;}" : ";}"); 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; + PL_last_lop = PL_last_uni = NULL; PL_minus_n = PL_minus_p = 0; goto retry; } PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr); - PL_last_lop = PL_last_uni = Nullch; + PL_last_lop = PL_last_uni = NULL; sv_setpvn(PL_linestr,"",0); TOKEN(';'); /* not infinite loop because rsfp is NULL now */ } @@ -2809,7 +2839,7 @@ Perl_yylex(pTHX) 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; + PL_last_lop = PL_last_uni = NULL; PL_doextract = FALSE; } } @@ -2817,22 +2847,22 @@ Perl_yylex(pTHX) } while (PL_doextract); PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s; if (PERLDB_LINE && PL_curstash != PL_debstash) { - SV * const sv = NEWSV(85,0); + SV * const sv = newSV(0); sv_upgrade(sv, SVt_PVMG); sv_setsv(sv,PL_linestr); (void)SvIOK_on(sv); SvIV_set(sv, 0); - av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv); + av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv); } PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); - PL_last_lop = PL_last_uni = Nullch; + PL_last_lop = PL_last_uni = NULL; if (CopLINE(PL_curcop) == 1) { while (s < PL_bufend && isSPACE(*s)) s++; if (*s == ':' && s[1] != ':') /* for csh execing sh scripts */ s++; - d = Nullch; + d = NULL; if (!PL_in_eval) { if (*s == '#' && *(s+1) == '!') d = s + 2; @@ -2863,7 +2893,8 @@ Perl_yylex(pTHX) * at least, set argv[0] to the basename of the Perl * interpreter. So, having found "#!", we'll set it right. */ - SV * const x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV)); /* $^X */ + SV * const x = GvSV(gv_fetchpvs("\030", GV_ADD|GV_NOTQUAL, + SVt_PV)); /* $^X */ assert(SvPOK(x) || SvGMAGICAL(x)); if (sv_eq(x, CopFILESV(PL_curcop))) { sv_setpvn(x, ipath, ipathend - ipath); @@ -2904,7 +2935,7 @@ Perl_yylex(pTHX) } } if (d < ipath) - d = Nullch; + d = NULL; } #endif } @@ -2923,7 +2954,7 @@ Perl_yylex(pTHX) while (*c && !strchr("; \t\r\n\f\v#", *c)) c++; if (c < d) - d = Nullch; /* "perl" not in first word; ignore */ + d = NULL; /* "perl" not in first word; ignore */ else *s = '#'; /* Don't try to parse shebang line */ } @@ -2961,15 +2992,15 @@ Perl_yylex(pTHX) } #endif if (d) { - 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++ == '-') { const bool switches_done = PL_doswitches; + const U32 oldpdb = PL_perldb; + const bool oldn = PL_minus_n; + const bool oldp = PL_minus_p; + do { if (*d == 'M' || *d == 'm' || *d == 'C') { const char * const m = d; @@ -2995,20 +3026,12 @@ Perl_yylex(pTHX) 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; + PL_last_lop = PL_last_uni = NULL; PL_preambled = FALSE; if (PERLDB_LINE) (void)gv_fetchfile(PL_origfilename); goto retry; } - if (PL_doswitches && !switches_done) { - int argc = PL_origargc; - char **argv = PL_origargv; - do { - argc--,argv++; - } while (argc && argv[0][0] == '-' && argv[0][1]); - init_argv_symbols(argc,argv); - } } } } @@ -3104,7 +3127,7 @@ Perl_yylex(pTHX) case 'T': ftst = OP_FTTEXT; break; case 'B': ftst = OP_FTBINARY; break; case 'M': case 'A': case 'C': - gv_fetchpv("\024",TRUE, SVt_PV); + gv_fetchpvs("\024", GV_ADD|GV_NOTQUAL, SVt_PV); switch (tmp) { case 'M': ftst = OP_FTMTIME; break; case 'A': ftst = OP_FTATIME; break; @@ -3219,7 +3242,7 @@ Perl_yylex(pTHX) case '~': if (s[1] == '~' && (PL_expect == XOPERATOR || PL_expect == XTERMORDORDOR) - && FEATURE_IS_ENABLED("~~", 2)) + && FEATURE_IS_ENABLED("~~")) { s += 2; Eop(OP_SMARTMATCH); @@ -3288,7 +3311,7 @@ Perl_yylex(pTHX) attrs = append_elem(OP_LIST, attrs, newSVOP(OP_CONST, 0, sv)); SvREFCNT_dec(PL_lex_stuff); - PL_lex_stuff = Nullsv; + PL_lex_stuff = NULL; } else { if (len == 6 && strnEQ(s, "unique", len)) { @@ -3752,7 +3775,7 @@ Perl_yylex(pTHX) if (PL_expect == XOPERATOR) { if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) { PL_expect = XTERM; - depcom(); + deprecate_old(commaless_variable_list); return REPORT(','); /* grandfather non-comma-format format */ } } @@ -3810,7 +3833,7 @@ Perl_yylex(pTHX) t++; Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Multidimensional syntax %.*s not supported", - (t - PL_bufptr) + 1, PL_bufptr); + (int)((t - PL_bufptr) + 1), PL_bufptr); } } } @@ -3915,7 +3938,8 @@ Perl_yylex(pTHX) PL_bufptr = skipspace(PL_bufptr); Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Scalar value %.*s better written as $%.*s", - t-PL_bufptr, PL_bufptr, t-PL_bufptr-1, PL_bufptr+1); + (int)(t-PL_bufptr), PL_bufptr, + (int)(t-PL_bufptr-1), PL_bufptr+1); } } } @@ -4002,7 +4026,7 @@ Perl_yylex(pTHX) if (PL_expect == XOPERATOR) { if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) { PL_expect = XTERM; - depcom(); + deprecate_old(commaless_variable_list); return REPORT(','); /* grandfather non-comma-format format */ } else @@ -4019,7 +4043,7 @@ Perl_yylex(pTHX) if (PL_expect == XOPERATOR) { if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) { PL_expect = XTERM; - depcom(); + deprecate_old(commaless_variable_list); return REPORT(','); /* grandfather non-comma-format format */ } else @@ -4074,7 +4098,7 @@ Perl_yylex(pTHX) const char c = *start; GV *gv; *start = '\0'; - gv = gv_fetchpv(s, FALSE, SVt_PVCV); + gv = gv_fetchpv(s, 0, SVt_PVCV); *start = c; if (!gv) { s = scan_num(s, &yylval); @@ -4121,8 +4145,8 @@ Perl_yylex(pTHX) keylookup: { I32 tmp; I32 orig_keyword = 0; - GV *gv = Nullgv; - GV **gvp = 0; + GV *gv = NULL; + GV **gvp = NULL; PL_bufptr = s; s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len); @@ -4164,11 +4188,11 @@ Perl_yylex(pTHX) } if (tmp < 0) { /* second-class keyword? */ - GV *ogv = Nullgv; /* override (winner) */ - GV *hgv = Nullgv; /* hidden (loser) */ + GV *ogv = NULL; /* override (winner) */ + GV *hgv = NULL; /* hidden (loser) */ if (PL_expect != XOPERATOR && (*s != ':' || s[1] != ':')) { CV *cv; - if ((gv = gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVCV)) && + if ((gv = gv_fetchpvn_flags(PL_tokenbuf, len, 0, SVt_PVCV)) && (cv = GvCVu(gv))) { if (GvIMPORTED_CV(gv)) @@ -4191,27 +4215,17 @@ Perl_yylex(pTHX) else if (gv && !gvp && -tmp==KEY_lock /* XXX generalizable kludge */ && GvCVu(gv) - && !hv_fetch(GvHVn(PL_incgv), "Thread.pm", 9, FALSE)) + && !hv_fetchs(GvHVn(PL_incgv), "Thread.pm", FALSE)) { tmp = 0; /* any sub overrides "weak" keyword */ } - else if (gv && !gvp - && tmp == -KEY_err - && GvCVu(gv) - && PL_expect != XOPERATOR - && PL_expect != XTERMORDORDOR) - { - /* any sub overrides the "err" keyword, except when really an - * operator is expected */ - tmp = 0; - } else { /* no override */ tmp = -tmp; if (tmp == KEY_dump && ckWARN(WARN_MISC)) { Perl_warner(aTHX_ packWARN(WARN_MISC), "dump() better written as CORE::dump()"); } - gv = Nullgv; + gv = NULL; gvp = 0; if (hgv && tmp != KEY_x && tmp != KEY_CORE && ckWARN(WARN_AMBIGUOUS)) /* never ambiguous */ @@ -4233,11 +4247,13 @@ Perl_yylex(pTHX) just_a_word_zero_gv: gv = NULL; gvp = NULL; + orig_keyword = 0; } just_a_word: { SV *sv; int pkgname = 0; const char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]); + CV *cv; /* Get the rest if it looks like a package qualifier */ @@ -4269,25 +4285,32 @@ Perl_yylex(pTHX) if (len > 2 && PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':') { - if (ckWARN(WARN_BAREWORD) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV)) + if (ckWARN(WARN_BAREWORD) + && ! gv_fetchpvn_flags(PL_tokenbuf, len, 0, SVt_PVHV)) Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword \"%s\" refers to nonexistent package", PL_tokenbuf); len -= 2; PL_tokenbuf[len] = '\0'; - gv = Nullgv; + gv = NULL; gvp = 0; } else { + if (!gv) { + /* Mustn't actually add anything to a symbol table. + But also don't want to "initialise" any placeholder + constants that might already be there into full + blown PVGVs with attached PVCV. */ + gv = gv_fetchpvn_flags(PL_tokenbuf, len, + GV_NOADD_NOINIT, SVt_PVCV); + } len = 0; - if (!gv) - gv = gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVCV); } /* if we saw a global override before, get the right name */ if (gvp) { - sv = newSVpvn("CORE::GLOBAL::",14); + sv = newSVpvs("CORE::GLOBAL::"); sv_catpv(sv,PL_tokenbuf); } else { @@ -4312,6 +4335,20 @@ Perl_yylex(pTHX) if (len) goto safe_bareword; + /* Do the explicit type check so that we don't need to force + the initialisation of the symbol table to have a real GV. + Beware - gv may not really be a PVGV, cv may not really be + a PVCV, (because of the space optimisations that gv_init + understands) But they're true if for this symbol there is + respectively a typeglob and a subroutine. + */ + cv = gv ? ((SvTYPE(gv) == SVt_PVGV) + /* Real typeglob, so get the real subroutine: */ + ? GvCVu(gv) + /* A proxy for a subroutine in this package? */ + : SvOK(gv) ? (CV *) gv : NULL) + : NULL; + /* See if it's the indirect object for a list operator. */ if (PL_oldoldbufptr && @@ -4329,7 +4366,8 @@ Perl_yylex(pTHX) /* Two barewords in a row may indicate method call. */ - if ((isIDFIRST_lazy_if(s,UTF) || *s == '$') && (tmp=intuit_method(s,gv))) + if ((isIDFIRST_lazy_if(s,UTF) || *s == '$') && + (tmp = intuit_method(s, gv, cv))) return REPORT(tmp); /* If not a declared subroutine, it's an indirect object. */ @@ -4338,7 +4376,7 @@ Perl_yylex(pTHX) if ( ( !immediate_paren && (PL_last_lop_op == OP_SORT || - ((!gv || !GvCVu(gv)) && + ((!gv || !cv) && (PL_last_lop_op != OP_MAPSTART && PL_last_lop_op != OP_GREPSTART)))) || (PL_tokenbuf[0] == '_' && PL_tokenbuf[1] == '\0' @@ -4365,9 +4403,9 @@ Perl_yylex(pTHX) /* If followed by a paren, it's certainly a subroutine. */ if (*s == '(') { CLINE; - if (gv && GvCVu(gv)) { + if (cv) { for (d = s + 1; SPACE_OR_TAB(*d); d++) ; - if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) { + if (*d == ')' && (sv = gv_const_sv(gv))) { s = d + 1; goto its_constant; } @@ -4381,7 +4419,7 @@ Perl_yylex(pTHX) /* If followed by var or block, call it a method (unless sub) */ - if ((*s == '$' || *s == '{') && (!gv || !GvCVu(gv))) { + if ((*s == '$' || *s == '{') && (!gv || !cv)) { PL_last_lop = PL_oldbufptr; PL_last_lop_op = OP_METHOD; PREBLOCK(METHOD); @@ -4391,20 +4429,18 @@ Perl_yylex(pTHX) if (!orig_keyword && (isIDFIRST_lazy_if(s,UTF) || *s == '$') - && (tmp = intuit_method(s,gv))) + && (tmp = intuit_method(s, gv, cv))) return REPORT(tmp); /* Not a method, so call it a subroutine (if defined) */ - if (gv && GvCVu(gv)) { - CV* cv; + if (cv) { if (lastchar == '-' && ckWARN_d(WARN_AMBIGUOUS)) Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "Ambiguous use of -%s resolved as -&%s()", PL_tokenbuf, PL_tokenbuf); /* Check for a constant sub */ - cv = GvCV(gv); - if ((sv = cv_const_sv(cv))) { + if ((sv = gv_const_sv(gv))) { its_constant: SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv); ((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc(sv); @@ -4413,6 +4449,14 @@ Perl_yylex(pTHX) } /* Resolve to GV now. */ + if (SvTYPE(gv) != SVt_PVGV) { + gv = gv_fetchpv(PL_tokenbuf, 0, SVt_PVCV); + assert (SvTYPE(gv) == SVt_PVGV); + /* cv must have been some sort of placeholder, so + now needs replacing with a real code reference. */ + cv = GvCV(gv); + } + op_free(yylval.opval); yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv)); yylval.opval->op_private |= OPpENTERSUB_NOPAREN; @@ -4493,7 +4537,8 @@ Perl_yylex(pTHX) const char *pname = "main"; if (PL_tokenbuf[2] == 'D') pname = HvNAME_get(PL_curstash ? PL_curstash : PL_defstash); - gv = gv_fetchpv(Perl_form(aTHX_ "%s::DATA", pname), TRUE, SVt_PVIO); + gv = gv_fetchpv(Perl_form(aTHX_ "%s::DATA", pname), GV_ADD, + SVt_PVIO); GvMULTI_on(gv); if (!GvIO(gv)) GvIOp(gv) = newIO(); @@ -4632,7 +4677,7 @@ Perl_yylex(pTHX) /* When 'use switch' is in effect, continue has a dual life as a control operator. */ { - if (!FEATURE_IS_ENABLED("switch", 6)) + if (!FEATURE_IS_ENABLED("switch")) PREBLOCK(CONTINUE); else { /* We have to disambiguate the two senses of @@ -4649,7 +4694,8 @@ Perl_yylex(pTHX) } case KEY_chdir: - (void)gv_fetchpv("ENV",TRUE, SVt_PVHV); /* may use HOME */ + /* may use HOME */ + (void)gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV); UNI(OP_CHDIR); case KEY_close: @@ -4719,7 +4765,7 @@ Perl_yylex(pTHX) UNI(OP_DELETE); case KEY_dbmopen: - gv_fetchpv("AnyDBM_File::ISA", GV_ADDMULTI, SVt_PVAV); + gv_fetchpvs("AnyDBM_File::ISA", GV_ADDMULTI, SVt_PVAV); LOP(OP_DBMOPEN,XTERM); case KEY_dbmclose: @@ -5165,7 +5211,7 @@ Perl_yylex(pTHX) } if (PL_lex_stuff) { SvREFCNT_dec(PL_lex_stuff); - PL_lex_stuff = Nullsv; + PL_lex_stuff = NULL; } PL_expect = XTERM; TOKEN('('); @@ -5422,7 +5468,7 @@ Perl_yylex(pTHX) sv_setpv(PL_subname, tmpbuf); else { sv_setsv(PL_subname,PL_curstname); - sv_catpvn(PL_subname,"::",2); + sv_catpvs(PL_subname,"::"); sv_catpvn(PL_subname,tmpbuf,len); } s = skipspace(d); @@ -5489,7 +5535,7 @@ Perl_yylex(pTHX) if (have_proto) { PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, PL_lex_stuff); - PL_lex_stuff = Nullsv; + PL_lex_stuff = NULL; force_next(THING); } if (!have_name) { @@ -5623,10 +5669,11 @@ Perl_yylex(pTHX) char ctl_l[2]; ctl_l[0] = toCTRL('L'); ctl_l[1] = '\0'; - gv_fetchpv(ctl_l,TRUE, SVt_PV); + gv_fetchpvn_flags(ctl_l, 1, GV_ADD|GV_NOTQUAL, SVt_PV); } #else - gv_fetchpv("\f",TRUE, SVt_PV); /* Make sure $^L is defined */ + /* Make sure $^L is defined */ + gv_fetchpvs("\f", GV_ADD|GV_NOTQUAL, SVt_PV); #endif UNI(OP_ENTERWRITE); @@ -5653,6 +5700,7 @@ Perl_yylex(pTHX) static int S_pending_ident(pTHX) { + dVAR; register char *d; register I32 tmp = 0; /* pit holds the identifier we read and pending_ident is reset */ @@ -5708,7 +5756,7 @@ S_pending_ident(pTHX) HV * const stash = PAD_COMPNAME_OURSTASH(tmp); HEK * const stashname = HvNAME_HEK(stash); SV * const sym = newSVhek(stashname); - sv_catpvn(sym, "::", 2); + sv_catpvs(sym, "::"); sv_catpv(sym, PL_tokenbuf+1); yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym); yylval.opval->op_private = OPpCONST_ENTERED; @@ -5752,7 +5800,7 @@ S_pending_ident(pTHX) table. */ if (pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) { - GV *gv = gv_fetchpv(PL_tokenbuf+1, FALSE, SVt_PVAV); + GV *gv = gv_fetchpv(PL_tokenbuf+1, 0, SVt_PVAV); if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv))) && ckWARN(WARN_AMBIGUOUS)) { @@ -5768,21 +5816,21 @@ S_pending_ident(pTHX) yylval.opval->op_private = OPpCONST_ENTERED; gv_fetchpv( PL_tokenbuf+1, - PL_in_eval - ? (GV_ADDMULTI | GV_ADDINEVAL) - /* If the identifier refers to a stash, don't autovivify it. - * Change 24660 had the side effect of causing symbol table - * hashes to always be defined, even if they were freshly - * created and the only reference in the entire program was - * the single statement with the defined %foo::bar:: test. - * It appears that all code in the wild doing this actually - * wants to know whether sub-packages have been loaded, so - * by avoiding auto-vivifying symbol tables, we ensure that - * defined %foo::bar:: continues to be false, and the existing - * tests still give the expected answers, even though what - * they're actually testing has now changed subtly. - */ - : !(*PL_tokenbuf == '%' && *(d = PL_tokenbuf + strlen(PL_tokenbuf) - 1) == ':' && d[-1] == ':'), + /* If the identifier refers to a stash, don't autovivify it. + * Change 24660 had the side effect of causing symbol table + * hashes to always be defined, even if they were freshly + * created and the only reference in the entire program was + * the single statement with the defined %foo::bar:: test. + * It appears that all code in the wild doing this actually + * wants to know whether sub-packages have been loaded, so + * by avoiding auto-vivifying symbol tables, we ensure that + * defined %foo::bar:: continues to be false, and the existing + * tests still give the expected answers, even though what + * they're actually testing has now changed subtly. + */ + (*PL_tokenbuf == '%' && *(d = PL_tokenbuf + strlen(PL_tokenbuf) - 1) == ':' && d[-1] == ':' + ? 0 + : PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD), ((PL_tokenbuf[0] == '$') ? SVt_PV : (PL_tokenbuf[0] == '@') ? SVt_PVAV : SVt_PVHV)); @@ -5796,6 +5844,7 @@ S_pending_ident(pTHX) I32 Perl_keyword (pTHX_ const char *name, I32 len) { + dVAR; switch (len) { case 1: /* 5 tokens of length 1 */ @@ -6065,7 +6114,7 @@ Perl_keyword (pTHX_ const char *name, I32 len) case 'r': if (name[2] == 'r') { /* err */ - return -KEY_err; + return (FEATURE_IS_ENABLED("err") ? -KEY_err : 0); } goto unknown; @@ -6204,7 +6253,7 @@ Perl_keyword (pTHX_ const char *name, I32 len) case 'a': if (name[2] == 'y') { /* say */ - return (FEATURE_IS_ENABLED("say", 3) ? -KEY_say : 0); + return (FEATURE_IS_ENABLED("say") ? -KEY_say : 0); } goto unknown; @@ -6728,7 +6777,7 @@ Perl_keyword (pTHX_ const char *name, I32 len) if (name[2] == 'e' && name[3] == 'n') { /* when */ - return (FEATURE_IS_ENABLED("switch", 6) ? KEY_when : 0); + return (FEATURE_IS_ENABLED("switch") ? KEY_when : 0); } goto unknown; @@ -6811,7 +6860,7 @@ Perl_keyword (pTHX_ const char *name, I32 len) name[3] == 'a' && name[4] == 'k') { /* break */ - return (FEATURE_IS_ENABLED("switch", 6) ? -KEY_break : 0); + return (FEATURE_IS_ENABLED("switch") ? -KEY_break : 0); } goto unknown; @@ -6939,7 +6988,7 @@ Perl_keyword (pTHX_ const char *name, I32 len) name[3] == 'e' && name[4] == 'n') { /* given */ - return (FEATURE_IS_ENABLED("switch", 6) ? KEY_given : 0); + return (FEATURE_IS_ENABLED("switch") ? KEY_given : 0); } goto unknown; @@ -7760,7 +7809,7 @@ Perl_keyword (pTHX_ const char *name, I32 len) name[5] == 'l' && name[6] == 't') { /* default */ - return (FEATURE_IS_ENABLED("switch", 6) ? KEY_default : 0); + return (FEATURE_IS_ENABLED("switch") ? KEY_default : 0); } goto unknown; @@ -9160,6 +9209,7 @@ unknown: STATIC void S_checkcomma(pTHX_ register char *s, const char *name, const char *what) { + dVAR; const char *w; if (*s == ' ' && s[1] == '(') { /* XXX gotta be a better way */ @@ -9276,7 +9326,7 @@ 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)) { - sv_catpv(ERRSV, "Propagated"); + sv_catpvs(ERRSV, "Propagated"); yyerror(SvPV_nolen_const(ERRSV)); /* Duplicates the message inside eval */ (void)POPs; res = SvREFCNT_inc(sv); @@ -9308,6 +9358,7 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, SV *sv, SV *pv, STATIC char * S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp) { + dVAR; register char *d = dest; register char * const e = d + destlen - 3; /* two-character token, ending NUL */ for (;;) { @@ -9345,15 +9396,14 @@ S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_packag STATIC char * S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRLEN destlen, I32 ck_uni) { - register char *d; - register char *e; - char *bracket = Nullch; + dVAR; + char *bracket = NULL; char funny = *s++; + register char *d = dest; + register char * const e = d + destlen + 3; /* two-character token, ending NUL */ if (isSPACE(*s)) s = skipspace(s); - d = dest; - e = d + destlen - 3; /* two-character token, ending NUL */ if (isDIGIT(*s)) { while (isDIGIT(*s)) { if (d >= e) @@ -9428,15 +9478,15 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL if (isIDFIRST_lazy_if(d,UTF)) { d++; if (UTF) { - e = s; - while ((e < send && isALNUM_lazy_if(e,UTF)) || *e == ':') { - e += UTF8SKIP(e); - while (e < send && UTF8_IS_CONTINUED(*e) && is_utf8_mark((U8*)e)) - e += UTF8SKIP(e); + char *end = s; + while ((end < send && isALNUM_lazy_if(end,UTF)) || *end == ':') { + end += UTF8SKIP(end); + while (end < send && UTF8_IS_CONTINUED(*end) && is_utf8_mark((U8*)end)) + end += UTF8SKIP(end); } - Copy(s, d, e - s, char); - d += e - s; - s = e; + Copy(s, d, end - s, char); + d += end - s; + s = end; } else { while ((isALNUM(*s) || *s == ':') && d < e) @@ -9521,11 +9571,13 @@ Perl_pmflag(pTHX_ U32* pmfl, int ch) STATIC char * S_scan_pat(pTHX_ char *start, I32 type) { + dVAR; PMOP *pm; char *s = scan_str(start,FALSE,FALSE); + const char * const valid_flags = (type == OP_QR) ? "iomsx" : "iogcmsx"; if (!s) { - char * const delimiter = skipspace(start); + const char * const delimiter = skipspace(start); Perl_croak(aTHX_ *delimiter == '?' ? "Search pattern not terminated or ternary operator parsed as search pattern" : "Search pattern not terminated" ); @@ -9534,14 +9586,8 @@ S_scan_pat(pTHX_ char *start, I32 type) pm = (PMOP*)newPMOP(type, 0); if (PL_multi_open == '?') pm->op_pmflags |= PMf_ONCE; - if(type == OP_QR) { - while (*s && strchr("iomsx", *s)) - pmflag(&pm->op_pmflags,*s++); - } - else { - while (*s && strchr("iogcmsx", *s)) - pmflag(&pm->op_pmflags,*s++); - } + while (*s && strchr(valid_flags, *s)) + pmflag(&pm->op_pmflags,*s++); /* issue a warning if /c is specified,but /g is not */ if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL) && ckWARN(WARN_REGEXP)) @@ -9580,7 +9626,7 @@ S_scan_subst(pTHX_ char *start) if (!s) { if (PL_lex_stuff) { SvREFCNT_dec(PL_lex_stuff); - PL_lex_stuff = Nullsv; + PL_lex_stuff = NULL; } Perl_croak(aTHX_ "Substitution replacement not terminated"); } @@ -9603,17 +9649,17 @@ S_scan_subst(pTHX_ char *start) } if (es) { - SV *repl; + SV * const repl = newSVpvs(""); + PL_sublex_info.super_bufptr = s; PL_sublex_info.super_bufend = PL_bufend; PL_multi_end = 0; pm->op_pmflags |= PMf_EVAL; - repl = newSVpvn("",0); while (es-- > 0) sv_catpv(repl, es ? "eval " : "do "); - sv_catpvn(repl, "{ ", 2); + sv_catpvs(repl, "{ "); sv_catsv(repl, PL_lex_repl); - sv_catpvn(repl, " };", 2); + sv_catpvs(repl, " }"); SvEVALED_on(repl); SvREFCNT_dec(PL_lex_repl); PL_lex_repl = repl; @@ -9628,6 +9674,7 @@ S_scan_subst(pTHX_ char *start) STATIC char * S_scan_trans(pTHX_ char *start) { + dVAR; register char* s; OP *o; short *tbl; @@ -9647,7 +9694,7 @@ S_scan_trans(pTHX_ char *start) if (!s) { if (PL_lex_stuff) { SvREFCNT_dec(PL_lex_stuff); - PL_lex_stuff = Nullsv; + PL_lex_stuff = NULL; } Perl_croak(aTHX_ "Transliteration replacement not terminated"); } @@ -9686,12 +9733,12 @@ S_scan_trans(pTHX_ char *start) STATIC char * S_scan_heredoc(pTHX_ register char *s) { + dVAR; SV *herewas; I32 op_type = OP_SCALAR; I32 len; SV *tmpstr; char term; - const char newline[] = "\n"; const char *found_newline; register char *d; register char *e; @@ -9753,7 +9800,7 @@ S_scan_heredoc(pTHX_ register char *s) s = olds; } #endif - if ( outer || !(found_newline = ninstr(s,PL_bufend,newline,newline+1)) ) { + if ( outer || !(found_newline = memchr(s, '\n', PL_bufend - s)) ) { herewas = newSVpvn(s,PL_bufend-s); } else { @@ -9762,7 +9809,7 @@ S_scan_heredoc(pTHX_ register char *s) } s += SvCUR(herewas); - tmpstr = NEWSV(87,79); + tmpstr = newSV(79); sv_upgrade(tmpstr, SVt_PVIV); if (term == '\'') { op_type = OP_CONST; @@ -9778,8 +9825,8 @@ S_scan_heredoc(pTHX_ register char *s) PL_multi_open = PL_multi_close = '<'; term = *PL_tokenbuf; 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 * const bufptr = PL_sublex_info.super_bufptr; + char * const bufend = PL_sublex_info.super_bufend; char * const olds = s - SvCUR(herewas); s = strchr(bufptr, '\n'); if (!s) @@ -9822,7 +9869,7 @@ S_scan_heredoc(pTHX_ register char *s) sv_setsv(PL_linestr,herewas); PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); - PL_last_lop = PL_last_uni = Nullch; + PL_last_lop = PL_last_uni = NULL; } else sv_setpvn(tmpstr,"",0); /* avoid "uninitialized" warning */ @@ -9834,7 +9881,7 @@ S_scan_heredoc(pTHX_ register char *s) } CopLINE_inc(PL_curcop); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); - PL_last_lop = PL_last_uni = Nullch; + PL_last_lop = PL_last_uni = NULL; #ifndef PERL_STRICT_CR if (PL_bufend - PL_linestart >= 2) { if ((PL_bufend[-2] == '\r' && PL_bufend[-1] == '\n') || @@ -9851,13 +9898,13 @@ S_scan_heredoc(pTHX_ register char *s) PL_bufend[-1] = '\n'; #endif if (PERLDB_LINE && PL_curstash != PL_debstash) { - SV *sv = NEWSV(88,0); + SV * const sv = newSV(0); sv_upgrade(sv, SVt_PVMG); sv_setsv(sv,PL_linestr); (void)SvIOK_on(sv); SvIV_set(sv, 0); - av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop),sv); + av_store(CopFILEAVx(PL_curcop), (I32)CopLINE(PL_curcop),sv); } if (*s == term && memEQ(s,PL_tokenbuf,len)) { STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr); @@ -9908,14 +9955,14 @@ retval: STATIC char * S_scan_inputsymbol(pTHX_ char *start) { + dVAR; register char *s = start; /* current position in buffer */ - register char *d; - const char *e; char *end; I32 len; - d = PL_tokenbuf; /* start of temp holding space */ - e = PL_tokenbuf + sizeof PL_tokenbuf; /* end of temp holding space */ + char *d = PL_tokenbuf; /* start of temp holding space */ + const char * const e = PL_tokenbuf + sizeof PL_tokenbuf; /* end of temp holding space */ + end = strchr(s, '\n'); if (!end) end = PL_bufend; @@ -9961,7 +10008,7 @@ S_scan_inputsymbol(pTHX_ char *start) } else { bool readline_overriden = FALSE; - GV *gv_readline = Nullgv; + GV *gv_readline; GV **gvp; /* we're in a filehandle read situation */ d = PL_tokenbuf; @@ -9971,10 +10018,11 @@ S_scan_inputsymbol(pTHX_ char *start) Copy("ARGV",d,5,char); /* Check whether readline() is overriden */ - if (((gv_readline = gv_fetchpv("readline", FALSE, SVt_PVCV)) + gv_readline = gv_fetchpvs("readline", GV_NOTQUAL, SVt_PVCV); + if ((gv_readline && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline)) || - ((gvp = (GV**)hv_fetch(PL_globalstash, "readline", 8, FALSE)) + ((gvp = (GV**)hv_fetchs(PL_globalstash, "readline", FALSE)) && (gv_readline = *gvp) != (GV*)&PL_sv_undef && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))) readline_overriden = TRUE; @@ -9990,16 +10038,16 @@ S_scan_inputsymbol(pTHX_ char *start) */ if ((tmp = pad_findmy(d)) != NOT_IN_PAD) { if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) { - HV *stash = PAD_COMPNAME_OURSTASH(tmp); - HEK *stashname = HvNAME_HEK(stash); - SV *sym = sv_2mortal(newSVhek(stashname)); - sv_catpvn(sym, "::", 2); + HV * const stash = PAD_COMPNAME_OURSTASH(tmp); + HEK * const stashname = HvNAME_HEK(stash); + SV * const sym = sv_2mortal(newSVhek(stashname)); + sv_catpvs(sym, "::"); sv_catpv(sym, d+1); d = SvPVX(sym); goto intro_sym; } else { - OP *o = newOP(OP_PADSV, 0); + OP * const o = newOP(OP_PADSV, 0); o->op_targ = tmp; PL_lex_op = readline_overriden ? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED, @@ -10035,7 +10083,7 @@ intro_sym: /* If it's none of the above, it must be a literal filehandle ( or ) so build a simple readline OP */ else { - GV *gv = gv_fetchpv(d,TRUE, SVt_PVIO); + GV * const gv = gv_fetchpv(d, GV_ADD, SVt_PVIO); PL_lex_op = readline_overriden ? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, @@ -10096,6 +10144,7 @@ intro_sym: STATIC char * S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) { + dVAR; SV *sv; /* scalar value: string */ char *tmps; /* temp string, used for delimiter matching */ register char *s = start; /* current position in the buffer */ @@ -10138,9 +10187,9 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) PL_multi_close = term; - /* create a new SV to hold the contents. 87 is leak category, I'm - assuming. 79 is the SV's initial length. What a random number. */ - sv = NEWSV(87,79); + /* create a new SV to hold the contents. 79 is the SV's initial length. + What a random number. */ + sv = newSV(79); sv_upgrade(sv, SVt_PVIV); SvIV_set(sv, termcode); (void)SvPOK_only(sv); /* validate pointer */ @@ -10157,8 +10206,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) int offset = s - SvPVX_const(PL_linestr); const bool found = sv_cat_decode(sv, PL_encoding, PL_linestr, &offset, (char*)termstr, termlen); - const char *ns = SvPVX_const(PL_linestr) + offset; - char *svlast = SvEND(sv) - 1; + const char * const ns = SvPVX_const(PL_linestr) + offset; + char * const svlast = SvEND(sv) - 1; for (; s < ns; s++) { if (*s == '\n' && !PL_rsfp) @@ -10317,25 +10366,25 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) !(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) { sv_free(sv); CopLINE_set(PL_curcop, (line_t)PL_multi_start); - return Nullch; + return NULL; } /* we read a line, so increment our line counter */ CopLINE_inc(PL_curcop); /* update debugger info */ if (PERLDB_LINE && PL_curstash != PL_debstash) { - SV *sv = NEWSV(88,0); + SV * const sv = newSV(0); sv_upgrade(sv, SVt_PVMG); sv_setsv(sv,PL_linestr); (void)SvIOK_on(sv); SvIV_set(sv, 0); - av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop), sv); + av_store(CopFILEAVx(PL_curcop), (I32)CopLINE(PL_curcop), sv); } /* having changed the buffer, we must update PL_bufend */ PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); - PL_last_lop = PL_last_uni = Nullch; + PL_last_lop = PL_last_uni = NULL; } /* at this point, we have successfully read the delimited string */ @@ -10392,13 +10441,14 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) char * Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) { + dVAR; register const char *s = start; /* current position in buffer */ register char *d; /* destination in temp buffer */ register char *e; /* end of temp buffer */ NV nv; /* number read, as a double */ - SV *sv = Nullsv; /* place to put the converted number */ + SV *sv = NULL; /* place to put the converted number */ bool floatit; /* boolean: int or float? */ - const char *lastub = 0; /* position of last underbar */ + const char *lastub = NULL; /* position of last underbar */ static char const number_too_long[] = "Number too long"; /* We use the first character to decide what type of number this is */ @@ -10561,7 +10611,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); } - sv = NEWSV(92,0); + sv = newSV(0); if (overflowed) { if (n > 4294967295.0 && ckWARN(WARN_PORTABLE)) Perl_warner(aTHX_ packWARN(WARN_PORTABLE), @@ -10580,9 +10630,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) } if (just_zero && (PL_hints & HINT_NEW_INTEGER)) sv = new_constant(start, s - start, "integer", - sv, Nullsv, NULL); + sv, NULL, NULL); else if (PL_hints & HINT_NEW_BINARY) - sv = new_constant(start, s - start, "binary", sv, Nullsv, NULL); + sv = new_constant(start, s - start, "binary", sv, NULL, NULL); } break; @@ -10714,7 +10764,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) /* make an sv from the string */ - sv = NEWSV(92,0); + sv = newSV(0); /* We try to do an integer conversion first if no characters @@ -10723,7 +10773,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) if (!floatit) { UV uv; - int flags = grok_number (PL_tokenbuf, d - PL_tokenbuf, &uv); + const int flags = grok_number (PL_tokenbuf, d - PL_tokenbuf, &uv); if (flags == IS_NUMBER_IN_UV) { if (uv <= IV_MAX) @@ -10749,13 +10799,13 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) (PL_hints & HINT_NEW_INTEGER) ) sv = new_constant(PL_tokenbuf, d - PL_tokenbuf, (floatit ? "float" : "integer"), - sv, Nullsv, NULL); + sv, NULL, NULL); break; /* if it starts with a v, it could be a v-string */ case 'v': vstring: - sv = NEWSV(92,5); /* preallocate storage space */ + sv = newSV(5); /* preallocate storage space */ s = scan_vstring(s,sv); break; } @@ -10773,9 +10823,10 @@ vstring: STATIC char * S_scan_formline(pTHX_ register char *s) { + dVAR; register char *eol; register char *t; - SV *stuff = newSVpvn("",0); + SV * const stuff = newSVpvs(""); bool needargs = FALSE; bool eofmt = FALSE; @@ -10826,7 +10877,7 @@ S_scan_formline(pTHX_ register char *s) s = filter_gets(PL_linestr, PL_rsfp, 0); PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr); PL_bufend = PL_bufptr + SvCUR(PL_linestr); - PL_last_lop = PL_last_uni = Nullch; + PL_last_lop = PL_last_uni = NULL; if (!s) { s = PL_bufptr; break; @@ -10868,6 +10919,7 @@ STATIC void S_set_csh(pTHX) { #ifdef CSH + dVAR; if (!PL_cshlen) PL_cshlen = strlen(PL_cshname); #endif @@ -10876,8 +10928,9 @@ S_set_csh(pTHX) I32 Perl_start_subparse(pTHX_ I32 is_format, U32 flags) { + dVAR; const I32 oldsavestack_ix = PL_savestack_ix; - CV* outsidecv = PL_compcv; + CV* const outsidecv = PL_compcv; if (PL_compcv) { assert(SvTYPE(PL_compcv) == SVt_PVCV); @@ -10886,7 +10939,7 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags) save_item(PL_subname); SAVESPTR(PL_compcv); - PL_compcv = (CV*)NEWSV(1104,0); + PL_compcv = (CV*)newSV(0); sv_upgrade((SV *)PL_compcv, is_format ? SVt_PVFM : SVt_PVCV); CvFLAGS(PL_compcv) |= flags; @@ -10904,6 +10957,7 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags) int Perl_yywarn(pTHX_ const char *s) { + dVAR; PL_in_eval |= EVAL_WARNONLY; yyerror(s); PL_in_eval &= ~EVAL_WARNONLY; @@ -10913,6 +10967,7 @@ Perl_yywarn(pTHX_ const char *s) int Perl_yyerror(pTHX_ const char *s) { + dVAR; const char *where = NULL; const char *context = NULL; int contlen = -1; @@ -10965,7 +11020,7 @@ Perl_yyerror(pTHX_ const char *s) where = "within string"; } else { - SV *where_sv = sv_2mortal(newSVpvn("next char ", 10)); + SV * const where_sv = sv_2mortal(newSVpvs("next char ")); if (yychar < 32) Perl_sv_catpvf(aTHX_ where_sv, "^%c", toCTRL(yychar)); else if (isPRINT_LC(yychar)) @@ -11010,6 +11065,7 @@ Perl_yyerror(pTHX_ const char *s) STATIC char* S_swallow_bom(pTHX_ U8 *s) { + dVAR; const STRLEN slen = SvCUR(PL_linestr); switch (s[0]) { case 0xFF: @@ -11109,6 +11165,7 @@ S_swallow_bom(pTHX_ U8 *s) static void restore_rsfp(pTHX_ void *f) { + dVAR; PerlIO * const fp = (PerlIO*)f; if (PL_rsfp == PerlIO_stdin()) @@ -11122,6 +11179,7 @@ restore_rsfp(pTHX_ void *f) static I32 utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) { + dVAR; const STRLEN old = SvCUR(sv); const I32 count = FILTER_READ(idx+1, sv, maxlen); DEBUG_P(PerlIO_printf(Perl_debug_log, @@ -11143,6 +11201,7 @@ utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen) { + dVAR; const STRLEN old = SvCUR(sv); const I32 count = FILTER_READ(idx+1, sv, maxlen); DEBUG_P(PerlIO_printf(Perl_debug_log, @@ -11168,7 +11227,7 @@ vstring, as well as updating the passed in sv. Function must be called like - sv = NEWSV(92,5); + sv = newSV(5); s = scan_vstring(s,sv); The sv should already be large enough to store the vstring @@ -11179,6 +11238,7 @@ passed in, for performance reasons. char * Perl_scan_vstring(pTHX_ const char *s, SV *sv) { + dVAR; const char *pos = s; const char *start = s; if (*pos == 'v') pos++; /* get past 'v' */