Upgrade to podlators-2.1.0

[p5sagit/p5-mst-13.2.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 0b4da4d..261b1be 100644 (file)
--- 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);
@@ -2349,7 +2344,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) {
@@ -4017,6 +4012,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)
 
@@ -4048,6 +4048,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;