X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=62309a1f1b34525b508335cb77f43745b07c281e;hb=40292913857a1f6673784ce0d71c8906c48c369b;hp=73061e34a5c330936aeb91a9384ee6b374c08de5;hpb=a9164de832b5ec51cc67c737aaac2bb30eed3d1e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/op.c b/op.c index 73061e3..62309a1 100644 --- a/op.c +++ b/op.c @@ -378,6 +378,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv, cv = cx->blk_sub.cv; if (PL_debstash && CvSTASH(cv) == PL_debstash) { /* ignore DB'* scope */ saweval = i; /* so we know where we were called from */ + seq = cxstack[i].blk_oldcop->cop_seq; continue; } return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH); @@ -841,16 +842,16 @@ clear_pmop: lastpmop = pmop; pmop = pmop->op_pmnext; } + } #ifdef USE_ITHREADS - Safefree(PmopSTASHPV(cPMOPo)); + Safefree(PmopSTASHPV(cPMOPo)); #else - /* NOTE: PMOP.op_pmstash is not refcounted */ + /* NOTE: PMOP.op_pmstash is not refcounted */ #endif - } } cPMOPo->op_pmreplroot = Nullop; - ReREFCNT_dec(cPMOPo->op_pmregexp); - cPMOPo->op_pmregexp = (REGEXP*)NULL; + ReREFCNT_dec(PM_GETRE(cPMOPo)); + PM_SETRE(cPMOPo, (REGEXP*)NULL); break; } @@ -2034,9 +2035,15 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right) right->op_type == OP_SUBST || right->op_type == OP_TRANS)) { right->op_flags |= OPf_STACKED; - if (right->op_type != OP_MATCH && - ! (right->op_type == OP_TRANS && - right->op_private & OPpTRANS_IDENTICAL)) + if ((right->op_type != OP_MATCH && + ! (right->op_type == OP_TRANS && + right->op_private & OPpTRANS_IDENTICAL)) || + /* if SV has magic, then match on original SV, not on its copy. + see note in pp_helem() */ + (right->op_type == OP_MATCH && + (left->op_type == OP_AELEM || + left->op_type == OP_HELEM || + left->op_type == OP_AELEMFAST))) left = mod(left, right->op_type); if (right->op_type == OP_TRANS) o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right); @@ -2941,7 +2948,16 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags) pmop->op_pmpermflags |= PMf_LOCALE; pmop->op_pmflags = pmop->op_pmpermflags; - /* link into pm list */ + #ifdef USE_ITHREADS + { + SV* repointer = newSViv(0); + av_push(PL_regex_padav,SvREFCNT_inc(repointer)); + pmop->op_pmoffset = av_len(PL_regex_padav); + PL_regex_pad = AvARRAY(PL_regex_padav); + } + #endif + + /* link into pm list */ if (type != OP_TRANS && PL_curstash) { pmop->op_pmnext = HvPMROOT(PL_curstash); HvPMROOT(PL_curstash) = pmop; @@ -2975,8 +2991,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl) } if ((PL_hints & HINT_UTF8) || DO_UTF8(pat)) pm->op_pmdynflags |= PMdf_UTF8; - pm->op_pmregexp = CALLREGCOMP(aTHX_ p, p + plen, pm); - if (strEQ("\\s+", pm->op_pmregexp->precomp)) + PM_SETRE(pm, CALLREGCOMP(aTHX_ p, p + plen, pm)); + if (strEQ("\\s+", PM_GETRE(pm)->precomp)) pm->op_pmflags |= PMf_WHITE; op_free(expr); } @@ -3072,14 +3088,14 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl) } if (curop == repl && !(repl_has_vars - && (!pm->op_pmregexp - || pm->op_pmregexp->reganch & ROPT_EVAL_SEEN))) { + && (!PM_GETRE(pm) + || PM_GETRE(pm)->reganch & ROPT_EVAL_SEEN))) { pm->op_pmflags |= PMf_CONST; /* const for long enough */ pm->op_pmpermflags |= PMf_CONST; /* const for long enough */ prepend_elem(o->op_type, scalar(repl), o); } else { - if (curop == repl && !pm->op_pmregexp) { /* Has variables. */ + if (curop == repl && !PM_GETRE(pm)) { /* Has variables. */ pm->op_pmflags |= PMf_MAYBE_CONST; pm->op_pmpermflags |= PMf_MAYBE_CONST; } @@ -3186,6 +3202,7 @@ Perl_package(pTHX_ OP *o) op_free(o); } else { + deprecate("\"package\" with no arguments"); sv_setpv(PL_curstname,""); PL_curstash = Nullhv; } @@ -3930,7 +3947,6 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP * OP *next = 0; OP *listop; OP *o; - OP *condop; U8 loopflags = 0; if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB @@ -3992,7 +4008,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP * return Nullop; /* listop already freed by new_logop */ } if (listop) - ((LISTOP*)listop)->op_last->op_next = condop = + ((LISTOP*)listop)->op_last->op_next = (o == listop ? redo : LINKLIST(o)); } else @@ -4152,6 +4168,14 @@ Perl_cv_undef(pTHX_ CV *cv) } #endif /* USE_THREADS */ +#ifdef USE_ITHREADS + if (CvFILE(cv) && !CvXSUB(cv)) { + /* for XSUBs CvFILE point directly to static memory; __FILE__ */ + Safefree(CvFILE(cv)); + } + CvFILE(cv) = 0; +#endif + if (!CvXSUB(cv) && CvROOT(cv)) { #ifdef USE_THREADS if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr)) @@ -4297,7 +4321,12 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside) MUTEX_INIT(CvMUTEXP(cv)); CvOWNER(cv) = 0; #endif /* USE_THREADS */ +#ifdef USE_ITHREADS + CvFILE(cv) = CvXSUB(proto) ? CvFILE(proto) + : savepv(CvFILE(proto)); +#else CvFILE(cv) = CvFILE(proto); +#endif CvGV(cv) = CvGV(proto); CvSTASH(cv) = CvSTASH(proto); CvROOT(cv) = OpREFCNT_inc(CvROOT(proto)); @@ -4586,9 +4615,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) cv = (!name || GvCVGEN(gv)) ? Nullcv : GvCV(gv); -#ifdef GV_SHARED_CHECK - if (cv && GvSHARED(gv) && SvREADONLY(cv)) { - Perl_croak(aTHX_ "Can't define subroutine %s (GV is shared)", name); +#ifdef GV_UNIQUE_CHECK + if (cv && GvUNIQUE(gv) && SvREADONLY(cv)) { + Perl_croak(aTHX_ "Can't define subroutine %s (GV is unique)", name); } #endif @@ -4600,9 +4629,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) if (cv) { bool exists = CvROOT(cv) || CvXSUB(cv); -#ifdef GV_SHARED_CHECK - if (exists && GvSHARED(gv)) { - Perl_croak(aTHX_ "Can't redefine shared subroutine %s", name); +#ifdef GV_UNIQUE_CHECK + if (exists && GvUNIQUE(gv)) { + Perl_croak(aTHX_ "Can't redefine unique subroutine %s", name); } #endif @@ -4721,6 +4750,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) } /* ... before we throw it away */ SvREFCNT_dec(PL_compcv); + if (PERLDB_INTER)/* Advice debugger on the new sub. */ + ++PL_sub_generation; } else { cv = PL_compcv; @@ -4731,7 +4762,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) } } CvGV(cv) = gv; - CvFILE(cv) = CopFILE(PL_curcop); + CvFILE_set_from_cop(cv, PL_curcop); CvSTASH(cv) = PL_curstash; #ifdef USE_THREADS CvOWNER(cv) = 0; @@ -5090,9 +5121,9 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) else name = "STDOUT"; gv = gv_fetchpv(name,TRUE, SVt_PVFM); -#ifdef GV_SHARED_CHECK - if (GvSHARED(gv)) { - Perl_croak(aTHX_ "Bad symbol for form (GV is shared)"); +#ifdef GV_UNIQUE_CHECK + if (GvUNIQUE(gv)) { + Perl_croak(aTHX_ "Bad symbol for form (GV is unique)"); } #endif GvMULTI_on(gv); @@ -5109,7 +5140,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) cv = PL_compcv; GvFORM(gv) = cv; CvGV(cv) = gv; - CvFILE(cv) = CopFILE(PL_curcop); + CvFILE_set_from_cop(cv, PL_curcop); for (ix = AvFILLp(PL_comppad); ix > 0; ix--) { if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix])) @@ -6441,8 +6472,8 @@ Perl_ck_join(pTHX_ OP *o) OP *kid = cLISTOPo->op_first->op_sibling; if (kid && kid->op_type == OP_MATCH) { char *pmstr = "STRING"; - if (kPMOP->op_pmregexp) - pmstr = kPMOP->op_pmregexp->precomp; + if (PM_GETRE(kPMOP)) + pmstr = PM_GETRE(kPMOP)->precomp; Perl_warner(aTHX_ WARN_SYNTAX, "/%s/ should probably be written as \"%s\"", pmstr, pmstr); @@ -6750,7 +6781,15 @@ Perl_peep(pTHX_ register OP *o) { PL_curcop = ((COP*)o); } - goto nothin; + /* XXX: We avoid setting op_seq here to prevent later calls + to peep() from mistakenly concluding that optimisation + has already occurred. This doesn't fix the real problem, + though (See 20010220.007). AMS 20010719 */ + if (oldop && o->op_next) { + oldop->op_next = o->op_next; + continue; + } + break; case OP_SCALAR: case OP_LINESEQ: case OP_SCOPE: @@ -6889,9 +6928,9 @@ Perl_peep(pTHX_ register OP *o) svp = cSVOPx_svp(((BINOP*)o)->op_last); if ((!SvFAKE(sv = *svp) || !SvREADONLY(sv)) && !IS_PADCONST(sv)) { key = SvPV(sv, keylen); - if (SvUTF8(sv)) - keylen = -keylen; - lexname = newSVpvn_share(key, keylen, 0); + lexname = newSVpvn_share(key, + SvUTF8(sv) ? -(I32)keylen : keylen, + 0); SvREFCNT_dec(sv); *svp = lexname; } @@ -6909,9 +6948,8 @@ Perl_peep(pTHX_ register OP *o) if (!fields || !GvHV(*fields)) break; key = SvPV(*svp, keylen); - if (SvUTF8(*svp)) - keylen = -keylen; - indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE); + indsvp = hv_fetch(GvHV(*fields), key, + SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE); if (!indsvp) { Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" in variable %s of type %s", key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname))); @@ -6976,9 +7014,8 @@ Perl_peep(pTHX_ register OP *o) key_op = (SVOP*)key_op->op_sibling) { svp = cSVOPx_svp(key_op); key = SvPV(*svp, keylen); - if (SvUTF8(*svp)) - keylen = -keylen; - indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE); + indsvp = hv_fetch(GvHV(*fields), key, + SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE); if (!indsvp) { Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" " "in variable %s of type %s",