X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/7c75014e4b3bd5ebe368b5d6b981f310525d1389..1c480c903473b013658c29213ac3d1772ab6b63a:/pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index dc2c442..d66ddde 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -112,6 +112,7 @@ PP(pp_and)
 PP(pp_sassign)
 {
     dVAR; dSP; dPOPTOPssrl;
+    U32 wasfake = 0;
 
     if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
 	SV * const temp = left;
@@ -197,7 +198,14 @@ PP(pp_sassign)
 	}
 
     }
+    /* Allow glob assignments like *$x = ..., which, when the glob has a
+       SVf_FAKE flag, cannot be distinguished from $x = ... without looking
+       at the op tree. */
+    if( SvTYPE(right) == SVt_PVGV && cBINOP->op_last->op_type == OP_RV2GV
+     && (wasfake = SvFLAGS(right) & SVf_FAKE) )
+	SvFLAGS(right) &= ~SVf_FAKE;
     SvSetMagicSV(right, left);
+    if(wasfake) SvFLAGS(right) |= SVf_FAKE;
     SETs(right);
     RETURN;
 }
@@ -244,7 +252,7 @@ PP(pp_concat)
 	rcopied = TRUE;
     }
 
-    if (TARG != left) {
+    if (TARG != left) { /* not $l .= $r */
         STRLEN llen;
         const char* const lpv = SvPV_nomg_const(left, llen);
 	lbyte = !DO_UTF8(left);
@@ -254,22 +262,21 @@ PP(pp_concat)
 	else
 	    SvUTF8_off(TARG);
     }
-    else { /* TARG == left */
-        STRLEN llen;
+    else { /* $l .= $r */
 	if (!SvOK(TARG)) {
-	    if (left == right && ckWARN(WARN_UNINITIALIZED))
+	    if (left == right && ckWARN(WARN_UNINITIALIZED)) /* $l .= $l */
 		report_uninit(right);
 	    sv_setpvs(left, "");
 	}
-	(void)SvPV_nomg_const(left, llen);    /* Needed to set UTF8 flag */
-	lbyte = !DO_UTF8(left);
+	lbyte = (SvROK(left) && SvTYPE(SvRV(left)) == SVt_REGEXP)
+		    ?  !DO_UTF8(SvRV(left)) : !DO_UTF8(left);
 	if (IN_BYTES)
 	    SvUTF8_off(TARG);
     }
 
     if (!rcopied) {
 	if (left == right)
-	    /* $a.$a: do magic twice: tied might return different 2nd time */
+	    /* $r.$r: do magic twice: tied might return different 2nd time */
 	    SvGETMAGIC(right);
 	rpv = SvPV_nomg_const(right, rlen);
 	rbyte = !DO_UTF8(right);
@@ -405,7 +412,7 @@ PP(pp_preinc)
 {
     dVAR; dSP;
     if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
-	DIE(aTHX_ "%s", PL_no_modify);
+	Perl_croak_no_modify(aTHX);
     if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
         && SvIVX(TOPs) != IV_MAX)
     {
@@ -1219,7 +1226,7 @@ PP(pp_qr)
     SvROK_on(rv);
 
     if (pkg) {
-	HV* const stash = gv_stashpv(SvPV_nolen(pkg), GV_ADD);
+	HV *const stash = gv_stashsv(pkg, GV_ADD);
 	SvREFCNT_dec(pkg);
 	(void)sv_bless(rv, stash);
     }
@@ -1640,8 +1647,12 @@ Perl_do_readline(pTHX)
 	}
 	SvUPGRADE(sv, SVt_PV);
 	tmplen = SvLEN(sv);	/* remember if already alloced */
-	if (!tmplen && !SvREADONLY(sv))
-	    Sv_Grow(sv, 80);	/* try short-buffering it */
+	if (!tmplen && !SvREADONLY(sv)) {
+            /* try short-buffering it. Please update t/op/readline.t
+	     * if you change the growth length.
+	     */
+	    Sv_Grow(sv, 80);
+        }
 	offset = 0;
 	if (type == OP_RCATLINE && SvOK(sv)) {
 	    if (!SvPOK(sv)) {
@@ -2111,7 +2122,7 @@ PP(pp_subst)
 	 || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG))
 	       || SvTYPE(TARG) > SVt_PVLV)
 	     && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))))
-	DIE(aTHX_ "%s", PL_no_modify);
+	Perl_croak_no_modify(aTHX);
     PUTBACK;
 
   setup_match:
@@ -2600,7 +2611,10 @@ PP(pp_leavesublv)
 	    if (MARK == SP) {
 		/* Temporaries are bad unless they happen to be elements
 		 * of a tied hash or array */
-		if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY) &&
+		if ((SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP) ||
+		     (SvFLAGS(TOPs) & (SVf_READONLY | SVf_FAKE))
+		       == SVf_READONLY
+		    ) &&
 		    !(SvRMAGICAL(TOPs) && mg_find(TOPs, PERL_MAGIC_tiedelem))) {
 		    LEAVE;
 		    cxstack_ix--;
@@ -3027,7 +3041,7 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
     SvGETMAGIC(sv);
     if (!SvOK(sv)) {
 	if (SvREADONLY(sv))
-	    Perl_croak(aTHX_ "%s", PL_no_modify);
+	    Perl_croak_no_modify(aTHX);
 	prepare_SV_for_RV(sv);
 	switch (to_what) {
 	case OPpDEREF_SV: