X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=6a0c804b9ddd3e9b9ecc2ce9d16784da8823fc13;hb=f3f2f1a3479714dd7c55621da87bce4872a4ab17;hp=7be56fb264a55ea16dda7271f7d6b4daf720669a;hpb=7918f24d20384771923d344a382e1d16d9552018;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_ctl.c b/pp_ctl.c index 7be56fb..6a0c804 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -231,7 +231,6 @@ PP(pp_substcont) if (!(cx->sb_rxtainted & 2) && SvTAINTED(TOPs)) cx->sb_rxtainted |= 2; sv_catsv(dstr, POPs); - FREETMPS; /* Prevent excess tmp stack */ /* Are we done */ if (CxONCE(cx) || !CALLREGEXEC(rx, s, cx->sb_strend, orig, @@ -298,7 +297,6 @@ PP(pp_substcont) { /* Update the pos() information. */ SV * const sv = cx->sb_targ; MAGIC *mg; - I32 i; SvUPGRADE(sv, SVt_PVMG); if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) { #ifdef PERL_OLD_COPY_ON_WRITE @@ -308,10 +306,7 @@ PP(pp_substcont) mg = sv_magicext(sv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob, NULL, 0); } - i = m - orig; - if (DO_UTF8(sv)) - sv_pos_b2u(sv, &i); - mg->mg_len = i; + mg->mg_len = m - orig; } if (old != rx) (void)ReREFCNT_inc(rx); @@ -443,7 +438,6 @@ PP(pp_formline) SV * nsv = NULL; OP * parseres = NULL; const char *fmt; - bool oneline; if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) { if (SvREADONLY(tmpForm)) { @@ -509,6 +503,7 @@ PP(pp_formline) *t = '\0'; sv_catpvn_utf8_upgrade(PL_formtarget, f, arg, nsv); t = SvEND(PL_formtarget); + f += arg; break; } if (!targ_is_utf8 && DO_UTF8(tmpForm)) { @@ -769,16 +764,12 @@ PP(pp_formline) case FF_LINESNGL: chopspace = 0; - oneline = TRUE; - goto ff_line; case FF_LINEGLOB: - oneline = FALSE; - ff_line: { + const bool oneline = fpc[-1] == FF_LINESNGL; const char *s = item = SvPV_const(sv, len); + item_is_utf8 = DO_UTF8(sv); itemsize = len; - if ((item_is_utf8 = DO_UTF8(sv))) - itemsize = sv_len_utf8(sv); if (itemsize) { bool chopped = FALSE; const char *const send = s + len; @@ -800,8 +791,6 @@ PP(pp_formline) } } SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget)); - if (targ_is_utf8) - SvUTF8_on(PL_formtarget); if (oneline) { SvCUR_set(sv, chophere - item); sv_catsv(PL_formtarget, sv); @@ -812,8 +801,10 @@ PP(pp_formline) SvCUR_set(PL_formtarget, SvCUR(PL_formtarget) - 1); SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1); t = SvPVX(PL_formtarget) + SvCUR(PL_formtarget); - if (item_is_utf8) + if (item_is_utf8) { targ_is_utf8 = TRUE; + sv_pos_b2u(sv, &itemsize); + } } break; } @@ -2153,8 +2144,9 @@ PP(pp_return) PL_curpm = newpm; /* ... and pop $1 et al */ LEAVESUB(sv); - if (clear_errsv) - sv_setpvn(ERRSV,"",0); + if (clear_errsv) { + CLEAR_ERRSV(); + } return retop; } @@ -2349,7 +2341,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit) /* First try all the kids at this level, since that's likeliest. */ for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) { if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) && - kCOP->cop_label && strEQ(kCOP->cop_label, label)) + CopLABEL(kCOP) && strEQ(CopLABEL(kCOP), label)) return kid; } for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) { @@ -3006,7 +2998,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) if (saveop && (saveop->op_type != OP_REQUIRE) && (saveop->op_flags & OPf_SPECIAL)) PL_in_eval |= EVAL_KEEPERR; else - sv_setpvn(ERRSV,"",0); + CLEAR_ERRSV(); if (yyparse() || PL_parser->error_count || !PL_eval_root) { SV **newsp; /* Used by POPBLOCK. */ PERL_CONTEXT *cx = &cxstack[cxstack_ix]; @@ -3357,11 +3349,11 @@ PP(pp_require) } } - if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVGV) { + if (SvROK(arg) && isGV_with_GP(SvRV(arg))) { arg = SvRV(arg); } - if (SvTYPE(arg) == SVt_PVGV) { + if (isGV_with_GP(arg)) { IO * const io = GvIO((GV *)arg); ++filter_has_file; @@ -3564,6 +3556,11 @@ PP(pp_require) SAVEHINTS(); PL_hints = 0; + if (PL_compiling.cop_hints_hash) { + Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints_hash); + PL_compiling.cop_hints_hash = NULL; + } + SAVECOMPILEWARNINGS(); if (PL_dowarn & G_WARN_ALL_ON) PL_compiling.cop_warnings = pWARN_ALL ; @@ -3605,6 +3602,19 @@ PP(pp_require) return op; } +/* This is a op added to hold the hints hash for + pp_entereval. The hash can be modified by the code + being eval'ed, so we return a copy instead. */ + +PP(pp_hintseval) +{ + dVAR; + dSP; + mXPUSHs((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv)); + RETURN; +} + + PP(pp_entereval) { dVAR; dSP; @@ -3759,8 +3769,9 @@ PP(pp_leaveeval) } else { LEAVE; - if (!(save_flags & OPf_SPECIAL)) - sv_setpvn(ERRSV,"",0); + if (!(save_flags & OPf_SPECIAL)) { + CLEAR_ERRSV(); + } } RETURNOP(retop); @@ -3804,7 +3815,7 @@ Perl_create_eval_scope(pTHX_ U32 flags) if (flags & G_KEEPERR) PL_in_eval |= EVAL_KEEPERR; else - sv_setpvn(ERRSV,"",0); + CLEAR_ERRSV(); if (flags & G_FAKINGEVAL) { PL_eval_root = PL_op; /* Only needed so that goto works right. */ } @@ -3863,7 +3874,7 @@ PP(pp_leavetry) PL_curpm = newpm; /* Don't pop $1 et al till now */ LEAVE; - sv_setpvn(ERRSV,"",0); + CLEAR_ERRSV(); RETURN; } @@ -3999,6 +4010,11 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) && (Other = d)) ) +# define SM_OBJECT ( \ + (sv_isobject(d) && (SvTYPE(SvRV(d)) != SVt_REGEXP)) \ + || \ + (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP)) ) \ + # define SM_OTHER_REF(type) \ (SvROK(Other) && SvTYPE(SvRV(Other)) == SVt_##type) @@ -4030,6 +4046,9 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) if (SvGMAGICAL(e)) e = sv_mortalcopy(e); + if (SM_OBJECT) + Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation"); + if (SM_CV_NEP) { I32 c;