X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/a2a5de9516c1b256b060768ac6dad252a3aa3be7..d343c3ef4538135207ab69cd65d1bb1ef5403ccc:/pp.c

diff --git a/pp.c b/pp.c
index d720b70..4b6d11f 100644
--- a/pp.c
+++ b/pp.c
@@ -202,7 +202,7 @@ PP(pp_rv2gv)
 	    }
 	    else {
 		if (PL_op->op_private & HINT_STRICT_REFS)
-		    DIE(aTHX_ PL_no_symref_sv, sv, "a symbol");
+		    DIE(aTHX_ PL_no_symref_sv, sv, (SvCUR(sv)>32 ? "..." : ""), "a symbol");
 		if ((PL_op->op_private & (OPpLVAL_INTRO|OPpDONT_INIT_GV))
 		    == OPpDONT_INIT_GV) {
 		    /* We are the target of a coderef assignment.  Return
@@ -232,7 +232,7 @@ Perl_softref2xv(pTHX_ SV *const sv, const char *const what,
 
     if (PL_op->op_private & HINT_STRICT_REFS) {
 	if (SvOK(sv))
-	    Perl_die(aTHX_ PL_no_symref_sv, sv, what);
+	    Perl_die(aTHX_ PL_no_symref_sv, sv, (SvCUR(sv)>32 ? "..." : ""), what);
 	else
 	    Perl_die(aTHX_ PL_no_usym, what);
     }
@@ -321,12 +321,19 @@ PP(pp_av2arylen)
 {
     dVAR; dSP;
     AV * const av = MUTABLE_AV(TOPs);
-    SV ** const sv = Perl_av_arylen_p(aTHX_ MUTABLE_AV(av));
-    if (!*sv) {
-	*sv = newSV_type(SVt_PVMG);
-	sv_magic(*sv, MUTABLE_SV(av), PERL_MAGIC_arylen, NULL, 0);
+    const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
+    if (lvalue) {
+	SV ** const sv = Perl_av_arylen_p(aTHX_ MUTABLE_AV(av));
+	if (!*sv) {
+	    *sv = newSV_type(SVt_PVMG);
+	    sv_magic(*sv, MUTABLE_SV(av), PERL_MAGIC_arylen, NULL, 0);
+	}
+	SETs(*sv);
+    } else {
+	SETs(sv_2mortal(newSViv(
+	    AvFILL(MUTABLE_AV(av)) + CopARYBASE_get(PL_curcop)
+	)));
     }
-    SETs(*sv);
     RETURN;
 }
 
@@ -342,8 +349,7 @@ PP(pp_pos)
 
 	LvTYPE(TARG) = '.';
 	if (LvTARG(TARG) != sv) {
-	    if (LvTARG(TARG))
-		SvREFCNT_dec(LvTARG(TARG));
+	    SvREFCNT_dec(LvTARG(TARG));
 	    LvTARG(TARG) = SvREFCNT_inc_simple(sv);
 	}
 	PUSHs(TARG);	/* no SvSETMAGIC */
@@ -422,6 +428,10 @@ PP(pp_prototype)
 		    ret = newSVpvs_flags("_;$", SVs_TEMP);
 		    goto set;
 		}
+		if (code == -KEY_keys || code == -KEY_values || code == -KEY_each) {
+		    ret = newSVpvs_flags("\\[@%]", SVs_TEMP);
+		    goto set;
+		}
 		if (code == -KEY_readpipe) {
 		    s = "CORE::backtick";
 		}
@@ -3190,8 +3200,7 @@ PP(pp_substr)
 	    sv_insert_flags(sv, pos, rem, repl, repl_len, 0);
 	    if (repl_is_utf8)
 		SvUTF8_on(sv);
-	    if (repl_sv_copy)
-		SvREFCNT_dec(repl_sv_copy);
+	    SvREFCNT_dec(repl_sv_copy);
 	}
 	else if (lvalue) {		/* it's an lvalue! */
 	    if (!SvGMAGICAL(sv)) {
@@ -3215,8 +3224,7 @@ PP(pp_substr)
 
 	    LvTYPE(TARG) = 'x';
 	    if (LvTARG(TARG) != sv) {
-		if (LvTARG(TARG))
-		    SvREFCNT_dec(LvTARG(TARG));
+		SvREFCNT_dec(LvTARG(TARG));
 		LvTARG(TARG) = SvREFCNT_inc_simple(sv);
 	    }
 	    LvTARGOFF(TARG) = upos;
@@ -3246,8 +3254,7 @@ PP(pp_vec)
 	}
 	LvTYPE(TARG) = 'v';
 	if (LvTARG(TARG) != src) {
-	    if (LvTARG(TARG))
-		SvREFCNT_dec(LvTARG(TARG));
+	    SvREFCNT_dec(LvTARG(TARG));
 	    LvTARG(TARG) = SvREFCNT_inc_simple(src);
 	}
 	LvTARGOFF(TARG) = offset;
@@ -3373,8 +3380,7 @@ PP(pp_index)
 	if (retval > 0 && big_utf8)
 	    sv_pos_b2u(big, &retval);
     }
-    if (temp)
-	SvREFCNT_dec(temp);
+    SvREFCNT_dec(temp);
  fail:
     PUSHi(retval + arybase);
     RETURN;
@@ -4517,9 +4523,9 @@ PP(pp_splice)
 	*MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg);
 	PUSHMARK(MARK);
 	PUTBACK;
-	ENTER;
+	ENTER_with_name("call_SPLICE");
 	call_method("SPLICE",GIMME_V);
-	LEAVE;
+	LEAVE_with_name("call_SPLICE");
 	SPAGAIN;
 	RETURN;
     }
@@ -4713,9 +4719,9 @@ PP(pp_push)
 	*MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg);
 	PUSHMARK(MARK);
 	PUTBACK;
-	ENTER;
+	ENTER_with_name("call_PUSH");
 	call_method("PUSH",G_SCALAR|G_DISCARD);
-	LEAVE;
+	LEAVE_with_name("call_PUSH");
 	SPAGAIN;
     }
     else {
@@ -4762,9 +4768,9 @@ PP(pp_unshift)
 	*MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg);
 	PUSHMARK(MARK);
 	PUTBACK;
-	ENTER;
+	ENTER_with_name("call_UNSHIFT");
 	call_method("UNSHIFT",G_SCALAR|G_DISCARD);
-	LEAVE;
+	LEAVE_with_name("call_UNSHIFT");
 	SPAGAIN;
     }
     else {
@@ -4785,17 +4791,76 @@ PP(pp_unshift)
 PP(pp_reverse)
 {
     dVAR; dSP; dMARK;
-    SV ** const oldsp = SP;
 
     if (GIMME == G_ARRAY) {
-	MARK++;
-	while (MARK < SP) {
-	    register SV * const tmp = *MARK;
-	    *MARK++ = *SP;
-	    *SP-- = tmp;
+	if (PL_op->op_private & OPpREVERSE_INPLACE) {
+	    AV *av;
+
+	    /* See pp_sort() */
+	    assert( MARK+1 == SP && *SP && SvTYPE(*SP) == SVt_PVAV);
+	    (void)POPMARK; /* remove mark associated with ex-OP_AASSIGN */
+	    av = MUTABLE_AV((*SP));
+	    /* In-place reversing only happens in void context for the array
+	     * assignment. We don't need to push anything on the stack. */
+	    SP = MARK;
+
+	    if (SvMAGICAL(av)) {
+		I32 i, j;
+		register SV *tmp = sv_newmortal();
+		/* For SvCANEXISTDELETE */
+		HV *stash;
+		const MAGIC *mg;
+		bool can_preserve = SvCANEXISTDELETE(av);
+
+		for (i = 0, j = av_len(av); i < j; ++i, --j) {
+		    register SV *begin, *end;
+
+		    if (can_preserve) {
+			if (!av_exists(av, i)) {
+			    if (av_exists(av, j)) {
+				register SV *sv = av_delete(av, j, 0);
+				begin = *av_fetch(av, i, TRUE);
+				sv_setsv_mg(begin, sv);
+			    }
+			    continue;
+			}
+			else if (!av_exists(av, j)) {
+			    register SV *sv = av_delete(av, i, 0);
+			    end = *av_fetch(av, j, TRUE);
+			    sv_setsv_mg(end, sv);
+			    continue;
+			}
+		    }
+
+		    begin = *av_fetch(av, i, TRUE);
+		    end   = *av_fetch(av, j, TRUE);
+		    sv_setsv(tmp,      begin);
+		    sv_setsv_mg(begin, end);
+		    sv_setsv_mg(end,   tmp);
+		}
+	    }
+	    else {
+		SV **begin = AvARRAY(av);
+		SV **end   = begin + AvFILLp(av);
+
+		while (begin < end) {
+		    register SV * const tmp = *begin;
+		    *begin++ = *end;
+		    *end--   = tmp;
+		}
+	    }
+	}
+	else {
+	    SV **oldsp = SP;
+	    MARK++;
+	    while (MARK < SP) {
+		register SV * const tmp = *MARK;
+		*MARK++ = *SP;
+		*SP--   = tmp;
+	    }
+	    /* safe as long as stack cannot get extended in the above */
+	    SP = oldsp;
 	}
-	/* safe as long as stack cannot get extended in the above */
-	SP = oldsp;
     }
     else {
 	register char *up;
@@ -4883,7 +4948,7 @@ PP(pp_split)
     I32 realarray = 0;
     I32 base;
     const I32 gimme = GIMME_V;
-    const bool gimme_scalar = (GIMME_V == G_SCALAR);
+    bool gimme_scalar;
     const I32 oldsave = PL_savestack_ix;
     U32 make_mortal = SVs_TEMP;
     bool multiline = 0;
@@ -4957,6 +5022,8 @@ PP(pp_split)
 	multiline = 1;
     }
 
+    gimme_scalar = gimme == G_SCALAR && !ary;
+
     if (!limit)
 	limit = maxiters + 2;
     if (RX_EXTFLAGS(rx) & RXf_WHITE) {
@@ -5263,9 +5330,9 @@ PP(pp_split)
 	}
 	else {
 	    PUTBACK;
-	    ENTER;
+	    ENTER_with_name("call_PUSH");
 	    call_method("PUSH",G_SCALAR|G_DISCARD);
-	    LEAVE;
+	    LEAVE_with_name("call_PUSH");
 	    SPAGAIN;
 	    if (gimme == G_ARRAY) {
 		I32 i;
@@ -5323,6 +5390,25 @@ PP(unimplemented_op)
     dVAR;
     DIE(aTHX_ "panic: unimplemented op %s (#%d) called", OP_NAME(PL_op),
 	PL_op->op_type);
+    return NORMAL;
+}
+
+PP(pp_boolkeys)
+{
+    dVAR;
+    dSP;
+    HV * const hv = (HV*)POPs;
+    
+    if (SvRMAGICAL(hv)) {
+	MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied);
+	if (mg) {
+            XPUSHs(magic_scalarpack(hv, mg));
+	    RETURN;
+        }	    
+    }
+
+    XPUSHs(boolSV(HvKEYS(hv) != 0));
+    RETURN;
 }
 
 /*