Fix a bunch of memory leaks in feature 'class'

 * Free the attrlist OP fragment when applying class or field attribute
 * Free the OP_PADxV ops we only use to get the pad index out for
   fieldvar declarations
 * Add a refcount to the `struct padname_fieldinfo` to keep track of its
   capture in inner closures so it can be freed at the right time
 * Free the class-related fields out of HvAUX
 * Free the actual ObjectFIELDS() array when destroying an object instance
 * Dup fieldinfo->paramname at sv_dup() time / free it at free time

Author: leonerd

class.c

@@ -601,6 +601,13 @@ Perl_class_apply_attributes(pTHX_ HV *stash, OP *attrlist)
 {
     PERL_ARGS_ASSERT_CLASS_APPLY_ATTRIBUTES;
 
+    if(!attrlist)
+        return;
+    if(attrlist->op_type == OP_NULL) {
+        op_free(attrlist);
+        return;
+    }
+
     if(attrlist->op_type == OP_LIST) {
         OP *o = cLISTOPx(attrlist)->op_first;
         assert(o->op_type == OP_PUSHMARK);
@@ -611,6 +618,8 @@ Perl_class_apply_attributes(pTHX_ HV *stash, OP *attrlist)
     }
     else
         S_class_apply_attribute(aTHX_ stash, attrlist);
+
+    op_free(attrlist);
 }
 
 static OP *
@@ -892,6 +901,7 @@ Perl_class_add_field(pTHX_ HV *stash, PADNAME *pn)
     Newxz(PadnameFIELDINFO(pn), 1, struct padname_fieldinfo);
     PadnameFLAGS(pn) |= PADNAMEf_FIELD;
 
+    PadnameFIELDINFO(pn)->refcount = 1;
     PadnameFIELDINFO(pn)->fieldix = fieldix;
     PadnameFIELDINFO(pn)->fieldstash = (HV *)SvREFCNT_inc(stash);
 
@@ -972,8 +982,12 @@ Perl_class_apply_field_attributes(pTHX_ PADNAME *pn, OP *attrlist)
 {
     PERL_ARGS_ASSERT_CLASS_APPLY_FIELD_ATTRIBUTES;
 
-    if(!attrlist || attrlist->op_type == OP_NULL)
+    if(!attrlist)
+        return;
+    if(attrlist->op_type == OP_NULL) {
+        op_free(attrlist);
         return;
+    }
 
     if(attrlist->op_type == OP_LIST) {
         OP *o = cLISTOPx(attrlist)->op_first;
@@ -985,6 +999,8 @@ Perl_class_apply_field_attributes(pTHX_ PADNAME *pn, OP *attrlist)
     }
     else
         S_class_apply_field_attribute(aTHX_ pn, attrlist);
+
+    op_free(attrlist);
 }
 
 void

hv.c

@@ -2278,6 +2278,7 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
        meaning that this structure might be read again at any point in the
        future without further checks or reinitialisation. */
     if (HvHasAUX(hv)) {
+      struct xpvhv_aux *aux = HvAUX(hv);
       struct mro_meta *meta;
       const char *name;
 
@@ -2295,7 +2296,7 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
        * effective names that need freeing, as well as the usual name. */
       name = HvNAME(hv);
       if (flags & HV_NAME_SETALL
-          ? cBOOL(HvAUX(hv)->xhv_name_u.xhvnameu_name)
+          ? cBOOL(aux->xhv_name_u.xhvnameu_name)
           : cBOOL(name))
       {
         if (name && PL_stashcache) {
@@ -2305,7 +2306,7 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
         }
         hv_name_set(hv, NULL, 0, flags);
       }
-      if((meta = HvAUX(hv)->xhv_mro_meta)) {
+      if((meta = aux->xhv_mro_meta)) {
         if (meta->mro_linear_all) {
             SvREFCNT_dec_NN(meta->mro_linear_all);
             /* mro_linear_current is just acting as a shortcut pointer,
@@ -2319,7 +2320,20 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
         SvREFCNT_dec(meta->isa);
         SvREFCNT_dec(meta->super);
         Safefree(meta);
-        HvAUX(hv)->xhv_mro_meta = NULL;
+        aux->xhv_mro_meta = NULL;
+      }
+
+      if(HvSTASH_IS_CLASS(hv)) {
+          SvREFCNT_dec(aux->xhv_class_superclass);
+          SvREFCNT_dec(aux->xhv_class_initfields_cv);
+          SvREFCNT_dec(aux->xhv_class_adjust_blocks);
+          if(aux->xhv_class_fields)
+            PadnamelistREFCNT_dec(aux->xhv_class_fields);
+          SvREFCNT_dec(aux->xhv_class_param_map);
+          Safefree(aux->xhv_class_suspended_initfields_compcv);
+          aux->xhv_class_suspended_initfields_compcv = NULL;
+
+          aux->xhv_aux_flags &= ~HvAUXf_IS_CLASS;
       }
     }
 

pad.c

@@ -2803,6 +2803,7 @@ Perl_newPADNAMEouter(PADNAME *outer)
     PadnameFLAGS(pn) = PADNAMEf_OUTER;
     if(PadnameIsFIELD(outer)) {
         PadnameFIELDINFO(pn) = PadnameFIELDINFO(outer);
+        PadnameFIELDINFO(pn)->refcount++;
         PadnameFLAGS(pn) |= PADNAMEf_FIELD;
     }
     PadnameLEN(pn) = PadnameLEN(outer);
@@ -2822,6 +2823,16 @@ Perl_padname_free(pTHX_ PADNAME *pn)
         SvREFCNT_dec(PadnameOURSTASH(pn));
         if (PadnameOUTER(pn))
             PadnameREFCNT_dec(PADNAME_FROM_PV(PadnamePV(pn)));
+        if (PadnameIsFIELD(pn)) {
+            struct padname_fieldinfo *info = PadnameFIELDINFO(pn);
+            if(!--info->refcount) {
+                SvREFCNT_dec(info->fieldstash);
+                /* todo: something about defop */
+                SvREFCNT_dec(info->paramname);
+
+                Safefree(info);
+            }
+        }
         Safefree(pn);
     }
 }
@@ -2864,13 +2875,15 @@ Perl_padname_dup(pTHX_ PADNAME *src, CLONE_PARAMS *param)
     PadnameTYPE   (dst) = (HV *)sv_dup_inc((SV *)PadnameTYPE(src), param);
     PadnameOURSTASH(dst) = (HV *)sv_dup_inc((SV *)PadnameOURSTASH(src),
                                             param);
-    if(PadnameIsFIELD(src)) {
+    if(PadnameIsFIELD(src) && !PadnameOUTER(src)) {
         struct padname_fieldinfo *sinfo = PadnameFIELDINFO(src);
         struct padname_fieldinfo *dinfo;
         Newxz(dinfo, 1, struct padname_fieldinfo);
 
+        dinfo->refcount   = 1;
         dinfo->fieldix    = sinfo->fieldix;
         dinfo->fieldstash = hv_dup_inc(sinfo->fieldstash, param);
+        dinfo->paramname  = sv_dup_inc(sinfo->paramname, param);
 
         PadnameFIELDINFO(dst) = dinfo;
     }

pad.h

@@ -94,6 +94,7 @@ struct padname_with_str {
  * own substructure, stored in ->xpadn_fieldinfo.
  */
 struct padname_fieldinfo {
+    U32        refcount;
     PADOFFSET  fieldix;    /* index of this field within ObjectFIELDS() array */
     HV        *fieldstash; /* original class package which added this field */
     OP        *defop;      /* optree fragment for defaulting expression */