Add new LVALUE flag for pad names

This will be used to record whether a pad entry is used as an lvalue
multiple times.  If so, it cannot be used as a constant.

diff --git a/pad.h b/pad.h
index d800b19..3ca79d3 100644 (file)
--- a/pad.h
+++ b/pad.h
@@ -301,7 +301,10 @@ Restore the old pad saved into the local variable opad by PAD_SAVE_LOCAL()
 #define PadnameOUTER(pn)       !!SvFAKE(pn)
 #define PadnameIsSTATE(pn)     !!SvPAD_STATE(pn)
 #define PadnameTYPE(pn)                (SvPAD_TYPED(pn) ? SvSTASH(pn) : NULL)
+#define PadnameLVALUE(pn) \
+    ((SvFLAGS(pn) & (SVpad_NAME|SVpad_LVALUE))==(SVpad_NAME|SVpad_LVALUE))
 
+#define PadnameLVALUE_on(pn)   (SvFLAGS(pn) |= SVpad_NAME|SVpad_LVALUE)
 
 #ifdef DEBUGGING
 #  define PAD_SV(po)      pad_sv(po)

diff --git a/sv.c b/sv.c
index 54f939f..a82350f 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -610,6 +610,8 @@ do_curse(pTHX_ SV * const sv) {
     if ((PL_stderrgv && GvGP(PL_stderrgv) && (SV*)GvIO(PL_stderrgv) == sv)
      || (PL_defoutgv && GvGP(PL_defoutgv) && (SV*)GvIO(PL_defoutgv) == sv))
        return;
+    if (SvPAD_NAME(sv))
+       return;
     (void)curse(sv, 0);
 }
 
@@ -6456,10 +6458,12 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
            goto free_head;
        }
 
-       assert(!SvOBJECT(sv) || type >= SVt_PVMG); /* objs are always >= MG */
+       /* objs are always >= MG, but pad names use the SVs_OBJECT flag
+          for another purpose  */
+       assert(!SvOBJECT(sv) || type >= SVt_PVMG || SvPAD_NAME(sv));
 
        if (type >= SVt_PVMG) {
-           if (SvOBJECT(sv)) {
+           if (SvOBJECT(sv) && !SvPAD_NAME(sv)) {
                if (!curse(sv, 1)) goto get_next_sv;
                type = SvTYPE(sv); /* destructor may have changed it */
            }
@@ -13314,7 +13318,9 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
 #endif
 
     /* don't clone objects whose class has asked us not to */
-    if (SvOBJECT(sstr) && ! (SvFLAGS(SvSTASH(sstr)) & SVphv_CLONEABLE)) {
+    if (SvOBJECT(sstr) && !SvPAD_NAME(sstr)
+     && ! (SvFLAGS(SvSTASH(sstr)) & SVphv_CLONEABLE))
+    {
        SvFLAGS(dstr) = 0;
        return dstr;
     }
@@ -13405,7 +13411,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
                    NOOP;
                } else if (SvMAGIC(dstr))
                    SvMAGIC_set(dstr, mg_dup(SvMAGIC(dstr), param));
-               if (SvOBJECT(dstr) && SvSTASH(dstr))
+               if (SvOBJECT(dstr) && !SvPAD_NAME(dstr) && SvSTASH(dstr))
                    SvSTASH_set(dstr, hv_dup_inc(SvSTASH(dstr), param));
                else SvSTASH_set(dstr, 0); /* don't copy DESTROY cache */
            }

diff --git a/sv.h b/sv.h
index bb3d572..6c77cce 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -380,6 +380,7 @@ perform the upgrade if necessary.  See C<svtype>.
 #define SVpad_OUR      0x00040000  /* pad name is "our" instead of "my" */
 #define SVs_TEMP       0x00080000  /* mortal (implies string is stealable) */
 #define SVs_OBJECT     0x00100000  /* is "blessed" */
+#define SVpad_LVALUE   0x00100000  /* pad name is used as lvalue */
 #define SVs_GMG                0x00200000  /* has magical get method */
 #define SVs_SMG                0x00400000  /* has magical set method */
 #define SVs_RMG                0x00800000  /* has random magical methods */
@@ -1143,6 +1144,7 @@ sv_force_normal does nothing.
 #define SvTAIL_on(sv)          (SvFLAGS(sv) |= SVpbm_TAIL)
 #define SvTAIL_off(sv)         (SvFLAGS(sv) &= ~SVpbm_TAIL)
 
+#define SvPAD_NAME(sv) ((SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME)
 
 #define SvPAD_TYPED(sv) \
        ((SvFLAGS(sv) & (SVpad_NAME|SVpad_TYPED)) == (SVpad_NAME|SVpad_TYPED))