This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Hash assignment can zap weak references to the hash
[perl5.git] / pp_hot.c
index 217ee26..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;
 }
@@ -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);
     }
@@ -2603,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--;