From 05fb84472b3efe94bcbf06e2a467eecf97cf1f8e Mon Sep 17 00:00:00 2001
From: "Paul \"LeoNerd\" Evans" <leonerd@leonerd.org.uk>
Date: Fri, 26 Sep 2025 17:50:32 +0100
Subject: [PATCH] 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.
---
 embed.fnc         |  2 +-
 inline.h          |  3 ++-
 pad.c             | 33 ++++++++++++++++++++++++---------
 proto.h           |  2 +-
 t/class/threads.t |  4 ++++
 5 files changed, 32 insertions(+), 12 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index 6f98a03911..49419bbf2a 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 592e06b597..08d6634b4a 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 a3b0d018b0..f97638211d 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 */
@@ -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;
-        Newxz(dinfo, 1, struct padname_fieldinfo);
+        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);
 
-        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;
+            /* 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 da25456df1..796a81d07c 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 0d9e6bf6a8..24ab57a5cb 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");