Sigh. This is what #10424 was supposed to check in.

p4raw-id: //depot/perl@10433

diff --git a/op.c b/op.c
index 49b242a..34fb48a 100644 (file)
--- a/op.c
+++ b/op.c
@@ -183,10 +183,9 @@ Perl_pad_allocmy(pTHX_ char *name)
        if (*name != '$')
            yyerror(Perl_form(aTHX_ "Can't declare class for non-scalar %s in \"%s\"",
                         name, PL_in_my == KEY_our ? "our" : "my"));
-       SvOBJECT_on(sv);
+       SvFLAGS(sv) |= SVpad_TYPED;
        (void)SvUPGRADE(sv, SVt_PVMG);
        SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash);
-       PL_sv_objcount++;
     }
     if (PL_in_my == KEY_our) {
        (void)SvUPGRADE(sv, SVt_PVGV);
@@ -223,11 +222,10 @@ S_pad_addlex(pTHX_ SV *proto_namesv)
        (void)SvUPGRADE(namesv, SVt_PVGV);
        GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)GvSTASH(proto_namesv));
     }
-    if (SvOBJECT(proto_namesv)) {              /* A typed var */
-       SvOBJECT_on(namesv);
+    if (SvFLAGS(proto_namesv) & SVpad_TYPED) { /* A typed lexical */
+       SvFLAGS(namesv) |= SVpad_TYPED;
        (void)SvUPGRADE(namesv, SVt_PVMG);
        SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(proto_namesv));
-       PL_sv_objcount++;
     }
     return newoff;
 }
@@ -1963,7 +1961,8 @@ S_my_kid(pTHX_ OP *o, OP *attrs)
 
        /* check for C<my Dog $spot> when deciding package */
        namesvp = av_fetch(PL_comppad_name, o->op_targ, FALSE);
-       if (namesvp && *namesvp && SvOBJECT(*namesvp) && HvNAME(SvSTASH(*namesvp)))
+       if (namesvp && *namesvp && (SvFLAGS(*namesvp) & SVpad_TYPED)
+           && HvNAME(SvSTASH(*namesvp)))
            stash = SvSTASH(*namesvp);
        else
            stash = PL_curstash;
@@ -6887,7 +6886,7 @@ Perl_peep(pTHX_ register OP *o)
            if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV)
                break;
            lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE);
-           if (!SvOBJECT(lexname))
+           if (!(SvFLAGS(lexname) & SVpad_TYPED))
                break;
            fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
            if (!fields || !GvHV(*fields))
@@ -6937,7 +6936,7 @@ Perl_peep(pTHX_ register OP *o)
            if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV)
                break;
            lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE);
-           if (!SvOBJECT(lexname))
+           if (!(SvFLAGS(lexname) & SVpad_TYPED))
                break;
            fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
            if (!fields || !GvHV(*fields))

diff --git a/sv.c b/sv.c
index 581c788..f56b45c 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4559,8 +4559,12 @@ Perl_sv_clear(pTHX_ register SV *sv)
                --PL_sv_objcount;       /* XXX Might want something more general */
        }
     }
-    if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
-       mg_free(sv);
+    if (SvTYPE(sv) >= SVt_PVMG) {
+       if (SvMAGIC(sv))
+           mg_free(sv);
+       if (SvFLAGS(sv) & SVpad_TYPED)
+           SvREFCNT_dec(SvSTASH(sv));
+    }
     stash = NULL;
     switch (SvTYPE(sv)) {
     case SVt_PVIO:

diff --git a/sv.h b/sv.h
index f9aa184..034b51e 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -217,6 +217,7 @@ perform the upgrade if necessary.  See C<svtype>.
 
 /* SVpad_OUR may be set on SVt_PV{NV,MG,GV} types */
 #define SVpad_OUR      0x80000000      /* pad name is "our" instead of "my" */
+#define SVpad_TYPED    0x40000000      /* Typed Lexical */
 
 #define SVf_IVisUV     0x80000000      /* use XPVUV instead of XPVIV */