Convert PAD_DUP to a function Perl_padlist_dup().

assert() that pads are never AvREAL().

5 files changed, 49 insertions, 1 deletions

diff --git a/embed.fnc b/embed.fnc
index 57dd568b1d..8e463c1275 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2079,6 +2079,11 @@ pd	|void	|pad_fixup_inner_anons|NN PADLIST *padlist|NN CV *old_cv|NN CV *new_cv
 pdX	|void	|pad_push	|NN PADLIST *padlist|int depth
 : Only used in PAD_COMPNAME_TYPE() in op.c
 pR	|HV*	|pad_compname_type|const PADOFFSET po
+: Used in sv.c
+#if defined(USE_ITHREADS)
+pR	|AV*	|padlist_dup	|NULLOK AV *const srcpad \
+				|NN CLONE_PARAMS *const param
+#endif
 
 #if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
 sd	|PADOFFSET|pad_findlex	|NN const char *name|NN const CV* cv|U32 seq|int warn \
diff --git a/embed.h b/embed.h
index b32891472c..90e80455ef 100644
--- a/embed.h
+++ b/embed.h
@@ -1777,6 +1777,11 @@
 #define pad_push		Perl_pad_push
 #define pad_compname_type	Perl_pad_compname_type
 #endif
+#if defined(USE_ITHREADS)
+#ifdef PERL_CORE
+#define padlist_dup		Perl_padlist_dup
+#endif
+#endif
 #if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
 #define pad_findlex		S_pad_findlex
@@ -4212,6 +4217,11 @@
 #define pad_push(a,b)		Perl_pad_push(aTHX_ a,b)
 #define pad_compname_type(a)	Perl_pad_compname_type(aTHX_ a)
 #endif
+#if defined(USE_ITHREADS)
+#ifdef PERL_CORE
+#define padlist_dup(a,b)	Perl_padlist_dup(aTHX_ a,b)
+#endif
+#endif
 #if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
 #define pad_findlex(a,b,c,d,e,f,g)	S_pad_findlex(aTHX_ a,b,c,d,e,f,g)
diff --git a/pad.c b/pad.c
index f941252692..99b25c8e59 100644
--- a/pad.c
+++ b/pad.c
@@ -1752,6 +1752,31 @@ Perl_pad_compname_type(pTHX_ const PADOFFSET po)
     return NULL;
 }
 
+#if defined(USE_ITHREADS)
+
+#  define av_dup_inc(s,t)	MUTABLE_AV(sv_dup_inc((const SV *)s,t))
+
+AV *
+Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
+{
+    AV *dstpad;
+    PERL_ARGS_ASSERT_PADLIST_DUP;
+
+    if (!srcpad)
+	return NULL;
+
+    assert(!AvREAL(srcpad));
+    /* XXX padlists are real, but pretend to be not */
+    AvREAL_on(srcpad);
+    dstpad = av_dup_inc(srcpad, param);
+    AvREAL_off(srcpad);
+    AvREAL_off(dstpad);
+
+    return dstpad;
+}
+
+#endif
+
 /*
  * Local variables:
  * c-indentation-style: bsd
diff --git a/proto.h b/proto.h
index 0acb1c556b..6ccf19ca68 100644
--- a/proto.h
+++ b/proto.h
@@ -6317,6 +6317,14 @@ PERL_CALLCONV void	Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
 PERL_CALLCONV HV*	Perl_pad_compname_type(pTHX_ const PADOFFSET po)
 			__attribute__warn_unused_result__;
 
+#if defined(USE_ITHREADS)
+PERL_CALLCONV AV*	Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
+			__attribute__warn_unused_result__
+			__attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_PADLIST_DUP	\
+	assert(param)
+
+#endif
 
 #if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
 STATIC PADOFFSET	S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, SV** out_capture, SV** out_name_sv, int *out_flags)
diff --git a/sv.c b/sv.c
index 380f44223f..0da4256fc7 100644
--- a/sv.c
+++ b/sv.c
@@ -11326,7 +11326,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
 		 * duped GV may never be freed. A bit of a hack! DAPM */
 		CvGV(dstr)	= (param->flags & CLONEf_JOIN_IN) ?
 		    NULL : gv_dup(CvGV(dstr), param) ;
-		PAD_DUP(CvPADLIST(dstr), CvPADLIST(sstr), param);
+		CvPADLIST(dstr) = padlist_dup(CvPADLIST(sstr), param);
 		CvOUTSIDE(dstr)	=
 		    CvWEAKOUTSIDE(sstr)
 		    ? cv_dup(    CvOUTSIDE(dstr), param)