diff --git a/embed.fnc b/embed.fnc index 6f98a039112d..49419bbf2a5b 100644 --- a/embed.fnc +++ b/embed.fnc @@ -6425,7 +6425,7 @@ Rdp |PADLIST *|padlist_dup |NN PADLIST *srcpad \ Rdp |PADNAME *|padname_dup |NN PADNAME *src \ |NN CLONE_PARAMS *param Rdp |PADNAMELIST *|padnamelist_dup \ - |NN PADNAMELIST *srcpad \ + |NULLOK PADNAMELIST *srcpad \ |NN CLONE_PARAMS *param Cp |yy_parser *|parser_dup |NULLOK const yy_parser * const proto \ |NN CLONE_PARAMS * const param diff --git a/inline.h b/inline.h index 592e06b597ab..08d6634b4ab0 100644 --- a/inline.h +++ b/inline.h @@ -4681,7 +4681,8 @@ Perl_padname_refcnt_inc(PADNAME *pn) PERL_STATIC_INLINE PADNAMELIST * Perl_padnamelist_refcnt_inc(PADNAMELIST *pnl) { - PadnamelistREFCNT(pnl)++; + if (pnl) + PadnamelistREFCNT(pnl)++; return pnl; } diff --git a/pad.c b/pad.c index 007bdd7172c0..f97638211d54 100644 --- a/pad.c +++ b/pad.c @@ -1295,6 +1295,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, return NOT_IN_PAD; if (PadnameIsFIELD(*out_name)) { + assert(PadnameFIELDINFO(*out_name)); HV *fieldstash = PadnameFIELDINFO(*out_name)->fieldstash; /* fields are only visible to the class that declared them */ @@ -2744,13 +2745,15 @@ Duplicates a pad name list. PADNAMELIST * Perl_padnamelist_dup(pTHX_ PADNAMELIST *srcpad, CLONE_PARAMS *param) { - PADNAMELIST *dstpad; - SSize_t max = PadnamelistMAX(srcpad); - PERL_ARGS_ASSERT_PADNAMELIST_DUP; + if (!srcpad) + return NULL; + + SSize_t max = PadnamelistMAX(srcpad); + /* look for it in the table first */ - dstpad = (PADNAMELIST *)ptr_table_fetch(PL_ptr_table, srcpad); + PADNAMELIST *dstpad = (PADNAMELIST *)ptr_table_fetch(PL_ptr_table, srcpad); if (dstpad) return dstpad; @@ -2827,6 +2830,7 @@ Perl_newPADNAMEouter(PADNAME *outer) PadnameREFCNT_inc(PADNAME_FROM_PV(PadnamePV(outer))); PadnameFLAGS(pn) = PADNAMEf_OUTER; if(PadnameIsFIELD(outer)) { + assert(PadnameFIELDINFO(outer)); PadnameFIELDINFO(pn) = PadnameFIELDINFO(outer); PadnameFIELDINFO(pn)->refcount++; PadnameFLAGS(pn) |= PADNAMEf_FIELD; @@ -2849,6 +2853,7 @@ Perl_padname_free(pTHX_ PADNAME *pn) if (PadnameOUTER(pn)) PadnameREFCNT_dec(PADNAME_FROM_PV(PadnamePV(pn))); if (PadnameIsFIELD(pn)) { + assert(PadnameFIELDINFO(pn)); struct padname_fieldinfo *info = PadnameFIELDINFO(pn); if(!--info->refcount) { SvREFCNT_dec(info->fieldstash); @@ -2900,18 +2905,27 @@ 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) && !PadnameOUTER(src)) { + if(PadnameIsFIELD(src)) { + assert(PadnameFIELDINFO(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; + struct padname_fieldinfo *dinfo = (struct padname_fieldinfo *)ptr_table_fetch(PL_ptr_table, src); + if (dinfo) + PadnameFIELDINFO(dst) = dinfo; + else { + Newxz(dinfo, 1, struct padname_fieldinfo); + PadnameFIELDINFO(dst) = dinfo; + ptr_table_store(PL_ptr_table, sinfo, dinfo); + + /* We must have set PadnameFIELDINFO(dst) before we recurse into + * fieldstash in case it points back here */ + dinfo->refcount = 1; + dinfo->fieldix = sinfo->fieldix; + dinfo->fieldstash = hv_dup_inc(sinfo->fieldstash, param); + dinfo->paramname = sv_dup_inc(sinfo->paramname, param); + } + assert(PadnameFIELDINFO(dst)); } + dst->xpadn_low = src->xpadn_low; dst->xpadn_high = src->xpadn_high; dst->xpadn_gen = src->xpadn_gen; diff --git a/proto.h b/proto.h index da25456df112..796a81d07c57 100644 --- a/proto.h +++ b/proto.h @@ -10848,7 +10848,7 @@ Perl_padnamelist_dup(pTHX_ PADNAMELIST *srcpad, CLONE_PARAMS *param) __attribute__warn_unused_result__ __attribute__visibility__("hidden"); # define PERL_ARGS_ASSERT_PADNAMELIST_DUP \ - assert(srcpad); assert(param) + assert(param) PERL_CALLCONV yy_parser * Perl_parser_dup(pTHX_ const yy_parser * const proto, CLONE_PARAMS * const param); diff --git a/t/class/threads.t b/t/class/threads.t index 0d9e6bf6a87c..24ab57a5cb8e 100644 --- a/t/class/threads.t +++ b/t/class/threads.t @@ -21,6 +21,10 @@ class Testcase1 { method x { return $x } } +class WithNoFields { + # a class with no fields, in order to test [GH23771] +} + { my $ret = threads->create(sub { pass("Created dummy thread");