Commit 6cd196534b for perl
commit 6cd196534b730ac2a60ff634bcd71ad49db76865
Author: Paul Evans <leonerd@leonerd.org.uk>
Date: Wed Oct 14 10:41:53 2026 +0100
Add pad_fetchmy_...() API
Similar to the `pad_findmy_...` functions, but emphasising that they
return the SV value out of the pad. This matters in the case of outer
captures in contexts where `CvLATE` is true (lexical and anon subs).
Currently only adds the _pvn and _sv variants; does not add the _pv or
_pvs as they are not currently needed.
diff --git a/embed.fnc b/embed.fnc
index 7302951bfa..d4bb7b3371 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2771,6 +2771,15 @@ p |void |pad_add_weakref|NN CV *func
Adpx |PADOFFSET|pad_alloc |I32 optype \
|U32 tmptype
dp |void |pad_block_start|int full
+Adp |PADOFFSET|pad_fetchmy_pvn \
+ |NN const char *namepv \
+ |STRLEN namelen \
+ |U32 flags \
+ |NULLOK SV **svp
+Adp |PADOFFSET|pad_fetchmy_sv \
+ |NN SV *name \
+ |U32 flags \
+ |NULLOK SV **svp
Adp |PADOFFSET|pad_findmy_pv|NN const char *name \
|U32 flags
Adp |PADOFFSET|pad_findmy_pvn \
diff --git a/embed.h b/embed.h
index ab0e816080..ad499da6a5 100644
--- a/embed.h
+++ b/embed.h
@@ -501,6 +501,8 @@
# define pad_add_name_pvn(a,b,c,d,e) Perl_pad_add_name_pvn(aTHX_ a,b,c,d,e)
# define pad_add_name_sv(a,b,c,d) Perl_pad_add_name_sv(aTHX_ a,b,c,d)
# define pad_alloc(a,b) Perl_pad_alloc(aTHX_ a,b)
+# define pad_fetchmy_pvn(a,b,c,d) Perl_pad_fetchmy_pvn(aTHX_ a,b,c,d)
+# define pad_fetchmy_sv(a,b,c) Perl_pad_fetchmy_sv(aTHX_ a,b,c)
# define pad_findmy_pv(a,b) Perl_pad_findmy_pv(aTHX_ a,b)
# define pad_findmy_pvn(a,b,c) Perl_pad_findmy_pvn(aTHX_ a,b,c)
# define pad_findmy_sv(a,b) Perl_pad_findmy_sv(aTHX_ a,b)
diff --git a/pad.c b/pad.c
index b75f9f34ad..ac89601bc9 100644
--- a/pad.c
+++ b/pad.c
@@ -1073,6 +1073,64 @@ Perl_pad_findmy_sv(pTHX_ SV *name, U32 flags)
return pad_findmy_pvn(namepv, namelen, flags);
}
+/*
+=for apidoc pad_fetchmy_pvn
+=for apidoc_item pad_fetchmy_sv
+
+Given the name of a lexical variable, including its leading sigil, these find
+it in the currently compiling pad, returning that offset and setting its
+pointer value into the C<SV *> variable pointed at by C<svp>, or returns
+C<NOT_IN_PAD> if no such lexical is in scope.
+
+If it is not in the current pad but appears in the pad of any lexically
+enclosing scope, then a pseudo-entry for it is added in the current pad. In
+this case, note that the SV returned in the C<svp> pointer is the outer-most
+one that was found, not the copy that was added in inner pads. This makes it
+subtly different from calling L</pad_findmy_pvn> and looking up the resulting
+offset in the C<PL_curpad> array in some cases (such as when compiling an
+anonymous or lexical sub, which have late binding of outer captures).
+
+The forms differ only in how the variable's name is specified.
+
+In C<pad_fetchmy_pvn>, C<namepv> points to the first byte of the name (which
+better be its sigil), and an additional parameter, C<namelen>, specifies its
+length in bytes. Hence, C<namepv> may contain embedded-NUL characters. The
+caller must make sure C<namepv> contains at least C<namelen> bytes.
+
+In C<pad_fetchmy_sv>, the variable name is taken from the SV parameter using
+C<L</SvPVutf8>()>.
+
+=cut
+*/
+
+PADOFFSET
+Perl_pad_fetchmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags,
+ SV **svp)
+{
+ PERL_ARGS_ASSERT_PAD_FETCHMY_PVN;
+
+ /* compilation errors can zero PL_compcv */
+ if (!PL_compcv)
+ return NOT_IN_PAD;
+
+ PADNAME *out_pn;
+ int out_flags;
+ PADOFFSET offset = pad_findlex(namepv, namelen, flags,
+ PL_compcv, PL_cop_seqmax, 1, svp, &out_pn, &out_flags);
+
+ return offset;
+}
+
+PADOFFSET
+Perl_pad_fetchmy_sv(pTHX_ SV *name, U32 flags, SV **svp)
+{
+ PERL_ARGS_ASSERT_PAD_FETCHMY_SV;
+
+ STRLEN namelen;
+ char *namepv = SvPVutf8(name, namelen);
+ return pad_fetchmy_pvn(namepv, namelen, flags, svp);
+}
+
/*
=for apidoc find_rundefsv
diff --git a/proto.h b/proto.h
index 19ecdc28d8..bdb3905473 100644
--- a/proto.h
+++ b/proto.h
@@ -6134,6 +6134,24 @@ Perl_pad_block_start(pTHX_ int full)
STMT_START { Perl_assert_aTHX; PERL_UNUSED_CONTEXT_FOR_ARGS_ASSERT; \
} STMT_END
+PERL_CALLCONV PADOFFSET
+Perl_pad_fetchmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags, SV **svp)
+ Perl_attribute_nonnull_aTHX
+ Perl_attribute_nonnull(pTHX_1);
+#define PERL_ARGS_ASSERT_PAD_FETCHMY_PVN \
+ STMT_START { Perl_assert_aTHX; assert(namepv); \
+ PERL_UNUSED_CONTEXT_FOR_ARGS_ASSERT; \
+ } STMT_END
+
+PERL_CALLCONV PADOFFSET
+Perl_pad_fetchmy_sv(pTHX_ SV *name, U32 flags, SV **svp)
+ Perl_attribute_nonnull_aTHX
+ Perl_attribute_nonnull(pTHX_1);
+#define PERL_ARGS_ASSERT_PAD_FETCHMY_SV \
+ STMT_START { Perl_assert_aTHX; assert(name); \
+ PERL_UNUSED_CONTEXT_FOR_ARGS_ASSERT; \
+ } STMT_END
+
PERL_CALLCONV PADOFFSET
Perl_pad_findmy_pv(pTHX_ const char *name, U32 flags)
Perl_attribute_nonnull_aTHX