X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=28ea26dd38e8ac2e31d71d7d4ca5373c0e33b0a9;hb=0a5d5e8be390bda2f9b7684490082d428228d28f;hp=b92edd3285cb71a3b863c7957784530eea5b9af1;hpb=aeea060ce4b653ecf5b0731f1cbfcf468f688acd;p=p5sagit%2Fp5-mst-13.2.git diff --git a/toke.c b/toke.c index b92edd3..28ea26d 100644 --- a/toke.c +++ b/toke.c @@ -784,7 +784,7 @@ scan_const(char *start) else if (*s == '$') { if (!lex_inpat) /* not a regexp, so $ must be var */ break; - if (s + 1 < send && !strchr(")| \n\t", s[1])) + if (s + 1 < send && !strchr("()| \n\t", s[1])) break; /* in regexp, $ might be tail anchor */ } if (*s == '\\' && s+1 < send) { @@ -1109,9 +1109,8 @@ filter_del(filter_t funcp) if (!rsfp_filters || AvFILL(rsfp_filters)<0) return; /* if filter is on top of stack (usual case) just pop it off */ - if (IoDIRP(FILTER_DATA(0)) == (void*)funcp){ - /* sv_free(av_pop(rsfp_filters)); */ - sv_free(av_shift(rsfp_filters)); + if (IoDIRP(FILTER_DATA(AvFILL(rsfp_filters))) == (void*)funcp){ + sv_free(av_pop(rsfp_filters)); return; } @@ -1227,12 +1226,12 @@ yylex(void) if (!strchr(tokenbuf,':')) { #ifdef USE_THREADS - /* Check for single character per-thread magicals */ + /* Check for single character per-thread SVs */ if (tokenbuf[0] == '$' && tokenbuf[2] == '\0' - && !isALPHA(tokenbuf[1]) /* Rule out obvious non-magicals */ - && (tmp = find_thread_magical(&tokenbuf[1])) != NOT_IN_PAD) + && !isALPHA(tokenbuf[1]) /* Rule out obvious non-threadsvs */ + && (tmp = find_threadsv(&tokenbuf[1])) != NOT_IN_PAD) { - yylval.opval = newOP(OP_SPECIFIC, 0); + yylval.opval = newOP(OP_THREADSV, 0); yylval.opval->op_targ = tmp; return PRIVATEREF; } @@ -1373,8 +1372,8 @@ yylex(void) nextval[nexttoke].ival = 0; force_next(','); #ifdef USE_THREADS - nextval[nexttoke].opval = newOP(OP_SPECIFIC, 0); - nextval[nexttoke].opval->op_targ = find_thread_magical("\""); + nextval[nexttoke].opval = newOP(OP_THREADSV, 0); + nextval[nexttoke].opval->op_targ = find_threadsv("\""); force_next(PRIVATEREF); #else force_ident("\"", '$'); @@ -2389,7 +2388,11 @@ yylex(void) case '/': /* may either be division or pattern */ case '?': /* may either be conditional or pattern */ if (expect != XOPERATOR) { - check_uni(); + /* Disable warning on "study /blah/" */ + if (oldoldbufptr == last_uni + && (*last_uni != 's' || s - last_uni < 5 + || memNE(last_uni, "study", 5) || isALNUM(last_uni[5]))) + check_uni(); s = scan_pat(s); TERM(sublex_start()); } @@ -2520,7 +2523,10 @@ yylex(void) case 'y': case 'Y': case 'z': case 'Z': - keylookup: + keylookup: { + GV *gv = Nullgv; + GV **gvp = 0; + bufptr = s; s = scan_word(s, tokenbuf, sizeof tokenbuf, FALSE, &len); @@ -2562,16 +2568,24 @@ yylex(void) } if (tmp < 0) { /* second-class keyword? */ - GV* gv; - if (expect != XOPERATOR && - (*s != ':' || s[1] != ':') && - (gv = gv_fetchpv(tokenbuf, FALSE, SVt_PVCV)) && - GvIMPORTED_CV(gv)) + if (expect != XOPERATOR && (*s != ':' || s[1] != ':') && + (((gv = gv_fetchpv(tokenbuf, FALSE, SVt_PVCV)) && + GvCVu(gv) && GvIMPORTED_CV(gv)) || + ((gvp = (GV**)hv_fetch(globalstash,tokenbuf,len,FALSE)) && + (gv = *gvp) != (GV*)&sv_undef && + GvCVu(gv) && GvIMPORTED_CV(gv)))) { - tmp = 0; + tmp = 0; /* overridden by importation */ + } + else if (gv && !gvp + && -tmp==KEY_lock /* XXX generalizable kludge */ + && !hv_fetch(GvHVn(incgv), "Thread.pm", 9, FALSE)) + { + tmp = 0; /* any sub overrides "weak" keyword */ + } + else { + tmp = -tmp; gv = Nullgv; gvp = 0; } - else - tmp = -tmp; } reserved_word: @@ -2579,7 +2593,6 @@ yylex(void) default: /* not a keyword */ just_a_word: { - GV *gv; SV *sv; char lastchar = (bufptr == oldoldbufptr ? 0 : bufptr[-1]); @@ -2604,12 +2617,19 @@ yylex(void) /* Look for a subroutine with this name in current package. */ - gv = gv_fetchpv(tokenbuf,FALSE, SVt_PVCV); + if (gvp) { + sv = newSVpv("CORE::GLOBAL::",14); + sv_catpv(sv,tokenbuf); + } + else + sv = newSVpv(tokenbuf,0); + if (!gv) + gv = gv_fetchpv(tokenbuf,FALSE, SVt_PVCV); /* Presume this is going to be a bareword of some sort. */ CLINE; - yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0)); + yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv); yylval.opval->op_private = OPpCONST_BARE; /* See if it's the indirect object for a list operator. */ @@ -3745,7 +3765,7 @@ yylex(void) s = scan_trans(s); TERM(sublex_start()); } - } + }} } I32 @@ -4659,46 +4679,6 @@ scan_subst(char *start) return s; } -void -hoistmust(register PMOP *pm) -{ - dTHR; - if (!pm->op_pmshort && pm->op_pmregexp->regstart && - (!pm->op_pmregexp->regmust || pm->op_pmregexp->reganch & ROPT_ANCH) - ) { - if (!(pm->op_pmregexp->reganch & ROPT_ANCH)) - pm->op_pmflags |= PMf_SCANFIRST; - pm->op_pmshort = SvREFCNT_inc(pm->op_pmregexp->regstart); - pm->op_pmslen = SvCUR(pm->op_pmshort); - } - else if (pm->op_pmregexp->regmust) {/* is there a better short-circuit? */ - if (pm->op_pmshort && - sv_eq(pm->op_pmshort,pm->op_pmregexp->regmust)) - { - if (pm->op_pmflags & PMf_SCANFIRST) { - SvREFCNT_dec(pm->op_pmshort); - pm->op_pmshort = Nullsv; - } - else { - SvREFCNT_dec(pm->op_pmregexp->regmust); - pm->op_pmregexp->regmust = Nullsv; - return; - } - } - /* promote the better string */ - if ((!pm->op_pmshort && - !(pm->op_pmregexp->reganch & ROPT_ANCH_GPOS)) || - ((pm->op_pmflags & PMf_SCANFIRST) && - (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)))) { - SvREFCNT_dec(pm->op_pmshort); /* ok if null */ - pm->op_pmshort = pm->op_pmregexp->regmust; - pm->op_pmslen = SvCUR(pm->op_pmshort); - pm->op_pmregexp->regmust = Nullsv; - pm->op_pmflags |= PMf_SCANFIRST; - } - } -} - static char * scan_trans(char *start) { @@ -5370,7 +5350,7 @@ yyerror(char *s) if (in_eval & 2) warn("%_", msg); else if (in_eval) - sv_catsv(errsv, msg); + sv_catsv(ERRSV, msg); else PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg)); if (++error_count >= 10)