Hash assignment can zap weak references to the hash

[perl5.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index 0e52921..d66ddde 100644 (file)
--- 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,9 +262,9 @@ PP(pp_concat)
        else
            SvUTF8_off(TARG);
     }
-    else { /* TARG == left */
+    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, "");
        }
@@ -268,7 +276,7 @@ PP(pp_concat)
 
     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);
@@ -1218,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);
     }
@@ -1639,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)) {
@@ -2599,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--;