X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=28ea26dd38e8ac2e31d71d7d4ca5373c0e33b0a9;hb=0a5d5e8be390bda2f9b7684490082d428228d28f;hp=7cb0fc6836c8e64121ff7ccafca13d5e48a8c937;hpb=4e35701fd273ba8d0093a29660dee38a92408e9b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/toke.c b/toke.c index 7cb0fc6..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; } @@ -1225,27 +1224,39 @@ yylex(void) return PRIVATEREF; } - if (!strchr(tokenbuf,':') - && (tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) { - if (last_lop_op == OP_SORT && - tokenbuf[0] == '$' && - (tokenbuf[1] == 'a' || tokenbuf[1] == 'b') - && !tokenbuf[2]) + if (!strchr(tokenbuf,':')) { +#ifdef USE_THREADS + /* Check for single character per-thread SVs */ + if (tokenbuf[0] == '$' && tokenbuf[2] == '\0' + && !isALPHA(tokenbuf[1]) /* Rule out obvious non-threadsvs */ + && (tmp = find_threadsv(&tokenbuf[1])) != NOT_IN_PAD) { - for (d = in_eval ? oldoldbufptr : linestart; - d < bufend && *d != '\n'; - d++) + yylval.opval = newOP(OP_THREADSV, 0); + yylval.opval->op_targ = tmp; + return PRIVATEREF; + } +#endif /* USE_THREADS */ + if ((tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) { + if (last_lop_op == OP_SORT && + tokenbuf[0] == '$' && + (tokenbuf[1] == 'a' || tokenbuf[1] == 'b') + && !tokenbuf[2]) { - if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) { - croak("Can't use \"my %s\" in sort comparison", - tokenbuf); + for (d = in_eval ? oldoldbufptr : linestart; + d < bufend && *d != '\n'; + d++) + { + if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) { + croak("Can't use \"my %s\" in sort comparison", + tokenbuf); + } } } - } - yylval.opval = newOP(OP_PADANY, 0); - yylval.opval->op_targ = tmp; - return PRIVATEREF; + yylval.opval = newOP(OP_PADANY, 0); + yylval.opval->op_targ = tmp; + return PRIVATEREF; + } } /* Force them to make up their mind on "@foo". */ @@ -1360,7 +1371,13 @@ yylex(void) if (lex_dojoin) { nextval[nexttoke].ival = 0; force_next(','); +#ifdef USE_THREADS + nextval[nexttoke].opval = newOP(OP_THREADSV, 0); + nextval[nexttoke].opval->op_targ = find_threadsv("\""); + force_next(PRIVATEREF); +#else force_ident("\"", '$'); +#endif /* USE_THREADS */ nextval[nexttoke].ival = 0; force_next('$'); nextval[nexttoke].ival = 0; @@ -2371,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()); } @@ -2502,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); @@ -2544,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: @@ -2561,7 +2593,6 @@ yylex(void) default: /* not a keyword */ just_a_word: { - GV *gv; SV *sv; char lastchar = (bufptr == oldoldbufptr ? 0 : bufptr[-1]); @@ -2586,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. */ @@ -3727,7 +3765,7 @@ yylex(void) s = scan_trans(s); TERM(sublex_start()); } - } + }} } I32 @@ -4641,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) { @@ -5269,7 +5267,7 @@ start_subparse(I32 is_format, U32 flags) av_store(comppadlist, 1, (SV*)comppad); CvPADLIST(compcv) = comppadlist; - CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)outsidecv); + CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc(outsidecv); #ifdef USE_THREADS CvOWNER(compcv) = 0; New(666, CvMUTEXP(compcv), 1, perl_mutex); @@ -5352,7 +5350,7 @@ yyerror(char *s) if (in_eval & 2) warn("%_", msg); else if (in_eval) - sv_catsv(GvSV(errgv), msg); + sv_catsv(ERRSV, msg); else PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg)); if (++error_count >= 10)