X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=86bd41967d2b65ebf6ae4d22fe75a3f62aca26b3;hb=aaa68c4a88ea4a62f62819baf4cacc0ca679c5fa;hp=97f8d29778b6ce177beadfd49f044f8e979eb334;hpb=45645c0c182600881f3427c7498d7a9890d23152;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index 97f8d29..86bd419 100644
--- a/op.c
+++ b/op.c
@@ -1983,11 +1983,14 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
              desc, sample, sample);
     }
 
-    if (right->op_type == OP_MATCH ||
+    if (!(right->op_flags & OPf_STACKED) &&
+       (right->op_type == OP_MATCH ||
 	right->op_type == OP_SUBST ||
-	right->op_type == OP_TRANS) {
+	right->op_type == OP_TRANS)) {
 	right->op_flags |= OPf_STACKED;
-	if (right->op_type != OP_MATCH)
+	if (right->op_type != OP_MATCH &&
+            ! (right->op_type == OP_TRANS &&
+               right->op_private & OPpTRANS_IDENTICAL))
 	    left = mod(left, right->op_type);
 	if (right->op_type == OP_TRANS)
 	    o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
@@ -2684,7 +2687,9 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 	if (!squash) {
 		if (t == r ||
 		    (tlen == rlen && memEQ((char *)t, (char *)r, tlen)))
+		{
 		    o->op_private |= OPpTRANS_IDENTICAL;
+		}
 	}
 
 	while (t < tend || tfirst <= tlast) {
@@ -4467,7 +4472,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
          * skipping the prototype check
          */
         if (exists || SvPOK(cv))
-            cv_ckproto(cv, gv, ps);
+	    cv_ckproto(cv, gv, ps);
 	/* already defined (or promised)? */
 	if (exists || GvASSUMECV(gv)) {
 	    SV* const_sv;
@@ -6197,7 +6202,7 @@ Perl_ck_split(pTHX_ OP *o)
 	cLISTOPo->op_last = kid; /* There was only one element previously */
     }
 
-    if (kid->op_type != OP_MATCH) {
+    if (kid->op_type != OP_MATCH || kid->op_flags & OPf_STACKED) {
 	OP *sibl = kid->op_sibling;
 	kid->op_sibling = 0;
 	kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
@@ -6246,81 +6251,6 @@ Perl_ck_join(pTHX_ OP *o)
     return ck_fun(o);
 }
 
-STATIC OP *
-S_method_2entersub(pTHX_ OP *o, OP *o2, OP *svop)
-{
-    GV *gv;
-    SV *method = ((SVOP*)svop)->op_sv;
-    char *methname;
-    STRLEN methlen;
-    HV *stash;
-    OP *mop;
-
-    if (svop->op_type == OP_METHOD_NAMED) {
-        methname = SvPV(method, methlen);
-    }
-    else {
-        return Nullop;
-    }
-
-    if (o2->op_type == OP_CONST) {
-        STRLEN len;
-        char *package = SvPV(((SVOP*)o2)->op_sv, len);
-        stash = gv_stashpvn(package, len, FALSE);
-    }
-    else if (o2->op_type == OP_PADSV) {
-        /* my Dog $spot = shift; $spot->bark */
-        SV *sv = *av_fetch(PL_comppad_name, o2->op_targ, FALSE);
-        if (sv && SvOBJECT(sv)) {
-            stash = SvSTASH(sv);
-        }
-        else {
-            return Nullop;
-        }
-    }
-    else {
-        return Nullop;
-    }
-
-    /* -1 so cache globs are not created */
-    /* XXX: support SUPER:: and UNIVERSAL, but not AUTOLOAD */
-    if (!(stash && (gv = gv_fetchmeth(stash, methname, methlen, -1)) && 
-          isGV(gv))) {
-        return Nullop;
-    }
-
-    /* XXX: check entire @ISA tree for readonly-ness ? */
-    if (GvSTASH(CvGV(GvCV(gv))) != stash) {
-        GV **gvp, *isagv;
-        AV *av;
-        gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE);
-        av = (gvp && (isagv = *gvp) && isagv != (GV*)&PL_sv_undef) ? 
-            GvAV(isagv) : Nullav;
-
-        if (isagv && av && !SvREADONLY((SV*)av)) {
-            return Nullop; /* @ISA is not frozen */
-        }
-
-        gv = CvGV(GvCV(gv)); /* point to the real gv */
-    }
-
-    if (o2->op_type == OP_CONST) {
-        /* remove bareword-ness of class name */
-        o2->op_private &= ~(OPpCONST_BARE|OPpCONST_STRICT); 
-    }
-
-    for (mop = o2; mop->op_sibling->op_sibling; mop = mop->op_sibling) ;
-
-    op_free(mop->op_sibling); /* loose OP_METHOD_NAMED */
-    mop->op_sibling = scalar(newUNOP(OP_RV2CV, 0,
-                                     newGVOP(OP_GV, 0, gv)));
-
-    ((cUNOPo->op_first->op_sibling)
-     ? cUNOPo : ((UNOP*)cUNOPo->op_first))->op_first->op_sibling = o2;
-
-    return ck_subr(o);
-}
-
 OP *
 Perl_ck_subr(pTHX_ OP *o)
 {
@@ -6355,16 +6285,8 @@ Perl_ck_subr(pTHX_ OP *o)
 	}
     }
     else if (cvop->op_type == OP_METHOD || cvop->op_type == OP_METHOD_NAMED) {
-	if ((PL_hints & HINT_CT_MRESOLVE) && /* use base qw(... +readonly) */
-            (o2->op_type == OP_CONST || o2->op_type == OP_PADSV)) {
-            OP *nop;
-            if ((nop = method_2entersub(o, o2, cvop))) {
-                return nop;
-            }
-        }
-	if (o2->op_type == OP_CONST) {
+	if (o2->op_type == OP_CONST)
 	    o2->op_private &= ~OPpCONST_STRICT;
-        }
 	else if (o2->op_type == OP_LIST) {
 	    OP *o = ((UNOP*)o2)->op_first->op_sibling;
 	    if (o && o->op_type == OP_CONST)