X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=8a686cd8fa3b2dacf96ac0e12b1ce9af66b2f179;hb=a6d8037e26aaceac1a62ab1a36249ff12386c7ff;hp=739a457936feff7575929b2040a1f09c679a67ba;hpb=af7df2578e5aff079dd90eeab57a2a48fb1a43c0;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index 739a457..8a686cd 100644
--- a/pp.c
+++ b/pp.c
@@ -2553,7 +2553,7 @@ PP(pp_complement)
 	      sv_usepvn_flags(TARG, (char*)result, nchar, SV_HAS_TRAILING_NUL);
 	      SvUTF8_off(TARG);
 	  }
-	  SETs(TARG);
+	  SETTARG;
 	  RETURN;
 	}
 #ifdef LIBERAL
@@ -2569,8 +2569,7 @@ PP(pp_complement)
 #endif
 	for ( ; anum > 0; anum--, tmps++)
 	    *tmps = ~*tmps;
-
-	SETs(TARG);
+	SETTARG;
       }
       RETURN;
     }
@@ -3514,7 +3513,7 @@ PP(pp_crypt)
 #   else
     sv_setpv(TARG, PerlProc_crypt(tmps, SvPV_nolen_const(right)));
 #   endif
-    SETs(TARG);
+    SETTARG;
     RETURN;
 #else
     DIE(aTHX_
@@ -3899,9 +3898,7 @@ PP(pp_quotemeta)
     }
     else
 	sv_setpvn(TARG, s, len);
-    SETs(TARG);
-    if (SvSMAGICAL(TARG))
-	mg_set(TARG);
+    SETTARG;
     RETURN;
 }
 
@@ -3915,7 +3912,17 @@ PP(pp_aslice)
 
     if (SvTYPE(av) == SVt_PVAV) {
 	const I32 arybase = CopARYBASE_get(PL_curcop);
-	if (lval && PL_op->op_private & OPpLVAL_INTRO) {
+	const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
+	bool can_preserve = FALSE;
+
+	if (localizing) {
+	    MAGIC *mg;
+	    HV *stash;
+
+	    can_preserve = SvCANEXISTDELETE(av);
+	}
+
+	if (lval && localizing) {
 	    register SV **svp;
 	    I32 max = -1;
 	    for (svp = MARK + 1; svp <= SP; svp++) {
@@ -3926,18 +3933,32 @@ PP(pp_aslice)
 	    if (max > AvMAX(av))
 		av_extend(av, max);
 	}
+
 	while (++MARK <= SP) {
 	    register SV **svp;
 	    I32 elem = SvIV(*MARK);
+	    bool preeminent = TRUE;
 
 	    if (elem > 0)
 		elem -= arybase;
+	    if (localizing && can_preserve) {
+		/* If we can determine whether the element exist,
+		 * Try to preserve the existenceness of a tied array
+		 * element by using EXISTS and DELETE if possible.
+		 * Fallback to FETCH and STORE otherwise. */
+		preeminent = av_exists(av, elem);
+	    }
+
 	    svp = av_fetch(av, elem, lval);
 	    if (lval) {
 		if (!svp || *svp == &PL_sv_undef)
 		    DIE(aTHX_ PL_no_aelem, elem);
-		if (PL_op->op_private & OPpLVAL_INTRO)
-		    save_aelem(av, elem, svp);
+		if (localizing) {
+		    if (preeminent)
+			save_aelem(av, elem, svp);
+		    else
+			SAVEADELETE(av, elem);
+		}
 	    }
 	    *MARK = svp ? *svp : &PL_sv_undef;
 	}
@@ -4045,12 +4066,195 @@ PP(pp_each)
     RETURN;
 }
 
-PP(pp_delete)
+STATIC OP *
+S_do_delete_local(pTHX)
 {
     dVAR;
     dSP;
     const I32 gimme = GIMME_V;
-    const I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
+    const MAGIC *mg;
+    HV *stash;
+
+    if (PL_op->op_private & OPpSLICE) {
+	dMARK; dORIGMARK;
+	SV * const osv = POPs;
+	const bool tied = SvRMAGICAL(osv)
+			    && mg_find((const SV *)osv, PERL_MAGIC_tied);
+	const bool can_preserve = SvCANEXISTDELETE(osv)
+				    || mg_find((const SV *)osv, PERL_MAGIC_env);
+	const U32 type = SvTYPE(osv);
+	if (type == SVt_PVHV) {			/* hash element */
+	    HV * const hv = MUTABLE_HV(osv);
+	    while (++MARK <= SP) {
+		SV * const keysv = *MARK;
+		SV *sv = NULL;
+		bool preeminent = TRUE;
+		if (can_preserve)
+		    preeminent = hv_exists_ent(hv, keysv, 0);
+		if (tied) {
+		    HE *he = hv_fetch_ent(hv, keysv, 1, 0);
+		    if (he)
+			sv = HeVAL(he);
+		    else
+			preeminent = FALSE;
+		}
+		else {
+		    sv = hv_delete_ent(hv, keysv, 0, 0);
+		    SvREFCNT_inc_simple_void(sv); /* De-mortalize */
+		}
+		if (preeminent) {
+		    save_helem_flags(hv, keysv, &sv, SAVEf_KEEPOLDELEM);
+		    if (tied) {
+			*MARK = sv_mortalcopy(sv);
+			mg_clear(sv);
+		    } else
+			*MARK = sv;
+		}
+		else {
+		    SAVEHDELETE(hv, keysv);
+		    *MARK = &PL_sv_undef;
+		}
+	    }
+	}
+	else if (type == SVt_PVAV) {                  /* array element */
+	    if (PL_op->op_flags & OPf_SPECIAL) {
+		AV * const av = MUTABLE_AV(osv);
+		while (++MARK <= SP) {
+		    I32 idx = SvIV(*MARK);
+		    SV *sv = NULL;
+		    bool preeminent = TRUE;
+		    if (can_preserve)
+			preeminent = av_exists(av, idx);
+		    if (tied) {
+			SV **svp = av_fetch(av, idx, 1);
+			if (svp)
+			    sv = *svp;
+			else
+			    preeminent = FALSE;
+		    }
+		    else {
+			sv = av_delete(av, idx, 0);
+		        SvREFCNT_inc_simple_void(sv); /* De-mortalize */
+		    }
+		    if (preeminent) {
+		        save_aelem_flags(av, idx, &sv, SAVEf_KEEPOLDELEM);
+			if (tied) {
+			    *MARK = sv_mortalcopy(sv);
+			    mg_clear(sv);
+			} else
+			    *MARK = sv;
+		    }
+		    else {
+		        SAVEADELETE(av, idx);
+		        *MARK = &PL_sv_undef;
+		    }
+		}
+	    }
+	}
+	else
+	    DIE(aTHX_ "Not a HASH reference");
+	if (gimme == G_VOID)
+	    SP = ORIGMARK;
+	else if (gimme == G_SCALAR) {
+	    MARK = ORIGMARK;
+	    if (SP > MARK)
+		*++MARK = *SP;
+	    else
+		*++MARK = &PL_sv_undef;
+	    SP = MARK;
+	}
+    }
+    else {
+	SV * const keysv = POPs;
+	SV * const osv   = POPs;
+	const bool tied = SvRMAGICAL(osv)
+			    && mg_find((const SV *)osv, PERL_MAGIC_tied);
+	const bool can_preserve = SvCANEXISTDELETE(osv)
+				    || mg_find((const SV *)osv, PERL_MAGIC_env);
+	const U32 type = SvTYPE(osv);
+	SV *sv = NULL;
+	if (type == SVt_PVHV) {
+	    HV * const hv = MUTABLE_HV(osv);
+	    bool preeminent = TRUE;
+	    if (can_preserve)
+		preeminent = hv_exists_ent(hv, keysv, 0);
+	    if (tied) {
+		HE *he = hv_fetch_ent(hv, keysv, 1, 0);
+		if (he)
+		    sv = HeVAL(he);
+		else
+		    preeminent = FALSE;
+	    }
+	    else {
+		sv = hv_delete_ent(hv, keysv, 0, 0);
+		SvREFCNT_inc_simple_void(sv); /* De-mortalize */
+	    }
+	    if (preeminent) {
+		save_helem_flags(hv, keysv, &sv, SAVEf_KEEPOLDELEM);
+		if (tied) {
+		    SV *nsv = sv_mortalcopy(sv);
+		    mg_clear(sv);
+		    sv = nsv;
+		}
+	    }
+	    else
+		SAVEHDELETE(hv, keysv);
+	}
+	else if (type == SVt_PVAV) {
+	    if (PL_op->op_flags & OPf_SPECIAL) {
+		AV * const av = MUTABLE_AV(osv);
+		I32 idx = SvIV(keysv);
+		bool preeminent = TRUE;
+		if (can_preserve)
+		    preeminent = av_exists(av, idx);
+		if (tied) {
+		    SV **svp = av_fetch(av, idx, 1);
+		    if (svp)
+			sv = *svp;
+		    else
+			preeminent = FALSE;
+		}
+		else {
+		    sv = av_delete(av, idx, 0);
+		    SvREFCNT_inc_simple_void(sv); /* De-mortalize */
+		}
+		if (preeminent) {
+		    save_aelem_flags(av, idx, &sv, SAVEf_KEEPOLDELEM);
+		    if (tied) {
+			SV *nsv = sv_mortalcopy(sv);
+			mg_clear(sv);
+			sv = nsv;
+		    }
+		}
+		else
+		    SAVEADELETE(av, idx);
+	    }
+	    else
+		DIE(aTHX_ "panic: avhv_delete no longer supported");
+	}
+	else
+	    DIE(aTHX_ "Not a HASH reference");
+	if (!sv)
+	    sv = &PL_sv_undef;
+	if (gimme != G_VOID)
+	    PUSHs(sv);
+    }
+
+    RETURN;
+}
+
+PP(pp_delete)
+{
+    dVAR;
+    dSP;
+    I32 gimme;
+    I32 discard;
+
+    if (PL_op->op_private & OPpLVAL_INTRO)
+	return do_delete_local();
+
+    gimme = GIMME_V;
+    discard = (gimme == G_VOID) ? G_DISCARD : 0;
 
     if (PL_op->op_private & OPpSLICE) {
 	dMARK; dORIGMARK;
@@ -4146,31 +4350,28 @@ PP(pp_hslice)
     register HV * const hv = MUTABLE_HV(POPs);
     register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
     const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
-    bool other_magic = FALSE;
+    bool can_preserve = FALSE;
 
     if (localizing) {
         MAGIC *mg;
         HV *stash;
 
-        other_magic = mg_find((const SV *)hv, PERL_MAGIC_env) ||
-            ((mg = mg_find((const SV *)hv, PERL_MAGIC_tied))
-             /* Try to preserve the existenceness of a tied hash
-              * element by using EXISTS and DELETE if possible.
-              * Fallback to FETCH and STORE otherwise */
-             && (stash = SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(hv), mg))))
-             && gv_fetchmethod_autoload(stash, "EXISTS", TRUE)
-             && gv_fetchmethod_autoload(stash, "DELETE", TRUE));
+	if (SvCANEXISTDELETE(hv) || mg_find((const SV *)hv, PERL_MAGIC_env))
+	    can_preserve = TRUE;
     }
 
     while (++MARK <= SP) {
         SV * const keysv = *MARK;
         SV **svp;
         HE *he;
-        bool preeminent = FALSE;
-
-        if (localizing) {
-            preeminent = SvRMAGICAL(hv) && !other_magic ? 1 :
-                hv_exists_ent(hv, keysv, 0);
+        bool preeminent = TRUE;
+
+        if (localizing && can_preserve) {
+	    /* If we can determine whether the element exist,
+             * try to preserve the existenceness of a tied hash
+             * element by using EXISTS and DELETE if possible.
+             * Fallback to FETCH and STORE otherwise. */
+            preeminent = hv_exists_ent(hv, keysv, 0);
         }
 
         he = hv_fetch_ent(hv, keysv, lval, 0);
@@ -4183,17 +4384,11 @@ PP(pp_hslice)
             if (localizing) {
 		if (HvNAME_get(hv) && isGV(*svp))
 		    save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL));
-		else {
-		    if (preeminent)
-			save_helem_flags(hv, keysv, svp,
-					 (PL_op->op_flags & OPf_SPECIAL) ? 0 : SAVEf_SETMAGIC);
-		    else {
-			STRLEN keylen;
-			const char * const key = SvPV_const(keysv, keylen);
-			SAVEDELETE(hv, savepvn(key,keylen),
-				   SvUTF8(keysv) ? -(I32)keylen : (I32)keylen);
-		    }
-		}
+		else if (preeminent)
+		    save_helem_flags(hv, keysv, svp,
+			 (PL_op->op_flags & OPf_SPECIAL) ? 0 : SAVEf_SETMAGIC);
+		else
+		    SAVEHDELETE(hv, keysv);
             }
         }
         *MARK = svp ? *svp : &PL_sv_undef;
@@ -4526,7 +4721,9 @@ PP(pp_push)
 	LEAVE;
 	SPAGAIN;
 	SP = ORIGMARK;
-	PUSHi( AvFILL(ary) + 1 );
+	if (GIMME_V != G_VOID) {
+	    PUSHi( AvFILL(ary) + 1 );
+	}
     }
     else {
 	PL_delaymagic = DM_DELAY;
@@ -4584,7 +4781,9 @@ PP(pp_unshift)
 	}
     }
     SP = ORIGMARK;
-    PUSHi( AvFILL(ary) + 1 );
+    if (GIMME_V != G_VOID) {
+	PUSHi( AvFILL(ary) + 1 );
+    }
     RETURN;
 }
 
@@ -4716,8 +4915,6 @@ PP(pp_split)
 	ary = GvAVn(pm->op_pmreplrootu.op_pmtargetgv);
     }
 #endif
-    else if (gimme != G_ARRAY)
-	ary = GvAVn(PL_defgv);
     else
 	ary = NULL;
     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
@@ -5040,9 +5237,9 @@ PP(pp_lock)
     dSP;
     dTOPss;
     SV *retsv = sv;
+    assert(SvTYPE(retsv) != SVt_PVCV);
     SvLOCK(sv);
-    if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
-	|| SvTYPE(retsv) == SVt_PVCV) {
+    if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV) {
 	retsv = refto(retsv);
     }
     SETs(retsv);