X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/93189314521460c01625b05f7cfa81ac855affa9..40b8d195ef25e04da53075384ae3c1fd5b4b5876:/toke.c diff --git a/toke.c b/toke.c index c60a929..641e3e3 100644 --- a/toke.c +++ b/toke.c @@ -424,8 +424,8 @@ Perl_lex_start(pTHX_ SV *line) SAVEPPTR(PL_last_uni); SAVEPPTR(PL_linestart); SAVESPTR(PL_linestr); - SAVEPPTR(PL_lex_brackstack); - SAVEPPTR(PL_lex_casestack); + SAVEGENERICPV(PL_lex_brackstack); + SAVEGENERICPV(PL_lex_casestack); SAVEDESTRUCTOR_X(restore_rsfp, PL_rsfp); SAVESPTR(PL_lex_stuff); SAVEI32(PL_lex_defer); @@ -440,8 +440,6 @@ Perl_lex_start(pTHX_ SV *line) PL_lex_brackets = 0; New(899, PL_lex_brackstack, 120, char); New(899, PL_lex_casestack, 12, char); - SAVEFREEPV(PL_lex_brackstack); - SAVEFREEPV(PL_lex_casestack); PL_lex_casemods = 0; *PL_lex_casestack = '\0'; PL_lex_dojoin = 0; @@ -1052,8 +1050,8 @@ S_sublex_push(pTHX) SAVEPPTR(PL_last_uni); SAVEPPTR(PL_linestart); SAVESPTR(PL_linestr); - SAVEPPTR(PL_lex_brackstack); - SAVEPPTR(PL_lex_casestack); + SAVEGENERICPV(PL_lex_brackstack); + SAVEGENERICPV(PL_lex_casestack); PL_linestr = PL_lex_stuff; PL_lex_stuff = Nullsv; @@ -1068,8 +1066,6 @@ S_sublex_push(pTHX) PL_lex_brackets = 0; New(899, PL_lex_brackstack, 120, char); New(899, PL_lex_casestack, 12, char); - SAVEFREEPV(PL_lex_brackstack); - SAVEFREEPV(PL_lex_casestack); PL_lex_casemods = 0; *PL_lex_casestack = '\0'; PL_lex_starts = 0; @@ -1273,7 +1269,7 @@ S_scan_const(pTHX_ char *start) if (min > max) { Perl_croak(aTHX_ - "Invalid [] range \"%c-%c\" in transliteration operator", + "Invalid range \"%c-%c\" in transliteration operator", (char)min, (char)max); } @@ -1611,7 +1607,7 @@ S_scan_const(pTHX_ char *start) /* \c is a control character */ case 'c': s++; - { + if (s < send) { U8 c = *s++; #ifdef EBCDIC if (isLOWER(c)) @@ -1619,6 +1615,9 @@ S_scan_const(pTHX_ char *start) #endif *d++ = NATIVE_TO_NEED(has_utf8,toCTRL(c)); } + else { + yyerror("Missing control char name in \\c"); + } continue; /* printf-style backslashes, formfeeds, newlines, etc */ @@ -1674,17 +1673,18 @@ S_scan_const(pTHX_ char *start) *d = '\0'; SvCUR_set(sv, d - SvPVX(sv)); if (SvCUR(sv) >= SvLEN(sv)) - Perl_croak(aTHX_ "panic: constant overflowed allocated space"); + Perl_croak(aTHX_ "panic: constant overflowed allocated space"); SvPOK_on(sv); if (PL_encoding && !has_utf8) { - sv_recode_to_utf8(sv, PL_encoding); - has_utf8 = TRUE; + sv_recode_to_utf8(sv, PL_encoding); + if (SvUTF8(sv)) + has_utf8 = TRUE; } if (has_utf8) { SvUTF8_on(sv); if (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op) { - PL_sublex_info.sub_op->op_private |= + PL_sublex_info.sub_op->op_private |= (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF); } } @@ -2204,6 +2204,7 @@ Perl_yylex(pTHX) GV *gv = Nullgv; GV **gvp = 0; bool bof = FALSE; + I32 orig_keyword = 0; /* check if there's an identifier for us to look at */ if (PL_pending_ident) @@ -2274,11 +2275,7 @@ Perl_yylex(pTHX) return ')'; } if (PL_lex_casemods > 10) { - char* newlb = Renew(PL_lex_casestack, PL_lex_casemods + 2, char); - if (newlb != PL_lex_casestack) { - SAVEFREEPV(newlb); - PL_lex_casestack = newlb; - } + Renew(PL_lex_casestack, PL_lex_casemods + 2, char); } PL_lex_casestack[PL_lex_casemods++] = *s; PL_lex_casestack[PL_lex_casemods] = '\0'; @@ -2322,13 +2319,7 @@ Perl_yylex(pTHX) if (PL_lex_dojoin) { PL_nextval[PL_nexttoke].ival = 0; force_next(','); -#ifdef USE_5005THREADS - PL_nextval[PL_nexttoke].opval = newOP(OP_THREADSV, 0); - PL_nextval[PL_nexttoke].opval->op_targ = find_threadsv("\""); - force_next(PRIVATEREF); -#else force_ident("\"", '$'); -#endif /* USE_5005THREADS */ PL_nextval[PL_nexttoke].ival = 0; force_next('$'); PL_nextval[PL_nexttoke].ival = 0; @@ -3118,11 +3109,7 @@ Perl_yylex(pTHX) leftbracket: s++; if (PL_lex_brackets > 100) { - char* newlb = Renew(PL_lex_brackstack, PL_lex_brackets + 1, char); - if (newlb != PL_lex_brackstack) { - SAVEFREEPV(newlb); - PL_lex_brackstack = newlb; - } + Renew(PL_lex_brackstack, PL_lex_brackets + 10, char); } switch (PL_expect) { case XTERM: @@ -3802,6 +3789,7 @@ Perl_yylex(pTHX) case 'z': case 'Z': keylookup: { + orig_keyword = 0; gv = Nullgv; gvp = 0; @@ -3866,6 +3854,7 @@ Perl_yylex(pTHX) } } if (ogv) { + orig_keyword = tmp; tmp = 0; /* overridden by import or by GLOBAL */ } else if (gv && !gvp @@ -4041,7 +4030,9 @@ Perl_yylex(pTHX) /* If followed by a bareword, see if it looks like indir obj. */ - if ((isIDFIRST_lazy_if(s,UTF) || *s == '$') && (tmp = intuit_method(s,gv))) + if (!orig_keyword + && (isIDFIRST_lazy_if(s,UTF) || *s == '$') + && (tmp = intuit_method(s,gv))) return tmp; /* Not a method, so call it a subroutine (if defined) */ @@ -4650,10 +4641,14 @@ Perl_yylex(pTHX) char *t; for (d = s; isALNUM_lazy_if(d,UTF); d++) ; t = skipspace(d); - if (strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE)) + if (strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE) + /* [perl #16184] */ + && !(t[0] == '=' && t[1] == '>') + ) { Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE), "Precedence problem: open %.*s should be open(%.*s)", - d-s,s, d-s,s); + d - s, s, d - s, s); + } } LOP(OP_OPEN,XTERM); @@ -5042,8 +5037,8 @@ Perl_yylex(pTHX) d[tmp] = '\0'; if (bad_proto && ckWARN(WARN_SYNTAX)) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "Illegal character in prototype for %s : %s", - SvPVX(PL_subname), d); + "Illegal character in prototype for %"SVf" : %s", + PL_subname, d); SvCUR(PL_lex_stuff) = tmp; have_proto = TRUE; @@ -5054,6 +5049,8 @@ Perl_yylex(pTHX) if (*s == ':' && s[1] != ':') PL_expect = attrful; + else if (!have_name && *s != '{' && key == KEY_sub) + Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine"); if (have_proto) { PL_nextval[PL_nexttoke].opval = @@ -5257,14 +5254,14 @@ S_pending_ident(pTHX) yyerror(Perl_form(aTHX_ "No package name allowed for " "variable %s in \"our\"", PL_tokenbuf)); - tmp = pad_allocmy(PL_tokenbuf); + tmp = allocmy(PL_tokenbuf); } else { if (strchr(PL_tokenbuf,':')) yyerror(Perl_form(aTHX_ PL_no_myglob,PL_tokenbuf)); yylval.opval = newOP(OP_PADANY, 0); - yylval.opval->op_targ = pad_allocmy(PL_tokenbuf); + yylval.opval->op_targ = allocmy(PL_tokenbuf); return PRIVATEREF; } } @@ -5282,23 +5279,11 @@ S_pending_ident(pTHX) */ if (!strchr(PL_tokenbuf,':')) { -#ifdef USE_5005THREADS - /* Check for single character per-thread SVs */ - if (PL_tokenbuf[0] == '$' && PL_tokenbuf[2] == '\0' - && !isALPHA(PL_tokenbuf[1]) /* Rule out obvious non-threadsvs */ - && (tmp = find_threadsv(&PL_tokenbuf[1])) != NOT_IN_PAD) - { - yylval.opval = newOP(OP_THREADSV, 0); - yylval.opval->op_targ = tmp; - return PRIVATEREF; - } -#endif /* USE_5005THREADS */ if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) { - SV *namesv = AvARRAY(PL_comppad_name)[tmp]; /* might be an "our" variable" */ - if (SvFLAGS(namesv) & SVpad_OUR) { + if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) { /* build ops for a bareword */ - SV *sym = newSVpv(HvNAME(GvSTASH(namesv)),0); + SV *sym = newSVpv(HvNAME(PAD_COMPNAME_OURSTASH(tmp)), 0); sv_catpvn(sym, "::", 2); sv_catpv(sym, PL_tokenbuf+1); yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym); @@ -6777,9 +6762,9 @@ S_scan_inputsymbol(pTHX_ char *start) add symbol table ops */ if ((tmp = pad_findmy(d)) != NOT_IN_PAD) { - SV *namesv = AvARRAY(PL_comppad_name)[tmp]; - if (SvFLAGS(namesv) & SVpad_OUR) { - SV *sym = sv_2mortal(newSVpv(HvNAME(GvSTASH(namesv)),0)); + if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) { + SV *sym = sv_2mortal( + newSVpv(HvNAME(PAD_COMPNAME_OURSTASH(tmp)),0)); sv_catpvn(sym, "::", 2); sv_catpv(sym, d+1); d = SvPVX(sym); @@ -7042,6 +7027,9 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) sv_catpvn(sv, s, 1); if (has_utf8) SvUTF8_on(sv); + else if (PL_encoding) + sv_recode_to_utf8(sv, PL_encoding); + PL_multi_end = CopLINE(PL_curcop); s++; @@ -7557,52 +7545,22 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags) { I32 oldsavestack_ix = PL_savestack_ix; CV* outsidecv = PL_compcv; - AV* comppadlist; if (PL_compcv) { assert(SvTYPE(PL_compcv) == SVt_PVCV); } SAVEI32(PL_subline); save_item(PL_subname); - SAVEI32(PL_padix); - SAVECOMPPAD(); - SAVESPTR(PL_comppad_name); SAVESPTR(PL_compcv); - SAVEI32(PL_comppad_name_fill); - SAVEI32(PL_min_intro_pending); - SAVEI32(PL_max_intro_pending); - SAVEI32(PL_pad_reset_pending); PL_compcv = (CV*)NEWSV(1104,0); sv_upgrade((SV *)PL_compcv, is_format ? SVt_PVFM : SVt_PVCV); CvFLAGS(PL_compcv) |= flags; - PL_comppad = newAV(); - av_push(PL_comppad, Nullsv); - PL_curpad = AvARRAY(PL_comppad); - PL_comppad_name = newAV(); - PL_comppad_name_fill = 0; - PL_min_intro_pending = 0; - PL_padix = 0; PL_subline = CopLINE(PL_curcop); -#ifdef USE_5005THREADS - av_store(PL_comppad_name, 0, newSVpvn("@_", 2)); - PL_curpad[0] = (SV*)newAV(); - SvPADMY_on(PL_curpad[0]); /* XXX Needed? */ -#endif /* USE_5005THREADS */ - - comppadlist = newAV(); - AvREAL_off(comppadlist); - av_store(comppadlist, 0, (SV*)PL_comppad_name); - av_store(comppadlist, 1, (SV*)PL_comppad); - - CvPADLIST(PL_compcv) = comppadlist; + CvPADLIST(PL_compcv) = pad_new(padnew_SAVE|padnew_SAVESUB); CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(outsidecv); -#ifdef USE_5005THREADS - CvOWNER(PL_compcv) = 0; - New(666, CvMUTEXP(PL_compcv), 1, perl_mutex); - MUTEX_INIT(CvMUTEXP(PL_compcv)); -#endif /* USE_5005THREADS */ + CvOUTSIDE_SEQ(PL_compcv) = PL_cop_seqmax; return oldsavestack_ix; }