Two bugfixes to field handling during thread cloning

This fixes two separate but related bugs.

 * Thread clone crashed if any class existed with no fields in it. This
   is fixed by permitting a NULL PADNAMELIST parameter to
   padnamelist_dup(). [GH23771]

 * Thread cloning would unreliably segfault due to missing
   PadnameFIELDINFO() of an outer closure capture, depending on the
   exact order of CV discovery. This is fixed by correct usage of the
   PL_ptr_table to store details of cloned `struct padname_fieldinfo`
   structures, and careful ordering of assignments and recursive clone
   calls.
This commit is contained in:
Paul "LeoNerd" Evans 2025-09-26 17:50:32 +01:00
parent 162b6fd168
commit 05fb84472b
5 changed files with 32 additions and 12 deletions

View File

@ -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

View File

@ -4681,6 +4681,7 @@ Perl_padname_refcnt_inc(PADNAME *pn)
PERL_STATIC_INLINE PADNAMELIST *
Perl_padnamelist_refcnt_inc(PADNAMELIST *pnl)
{
if (pnl)
PadnamelistREFCNT(pnl)++;
return pnl;
}

23
pad.c
View File

@ -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 */
@ -2746,6 +2747,9 @@ Perl_padnamelist_dup(pTHX_ PADNAMELIST *srcpad, CLONE_PARAMS *param)
{
PERL_ARGS_ASSERT_PADNAMELIST_DUP;
if (!srcpad)
return NULL;
SSize_t max = PadnamelistMAX(srcpad);
/* look for it in the table first */
@ -2826,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;
@ -2848,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);
@ -2899,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;
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);
PadnameFIELDINFO(dst) = dinfo;
}
assert(PadnameFIELDINFO(dst));
}
dst->xpadn_low = src->xpadn_low;
dst->xpadn_high = src->xpadn_high;
dst->xpadn_gen = src->xpadn_gen;

2
proto.h generated
View File

@ -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);

View File

@ -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");