From 04c0207ebb3cb7f894b5f5b6320970aabda477a9 Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Tue, 14 Feb 2023 22:50:42 +0000 Subject: 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 --- class.c | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) (limited to 'class.c') diff --git a/class.c b/class.c index 552030efa2..c94e494bf0 100644 --- a/class.c +++ b/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 -- cgit v1.2.1