Convert PAD_DUP to a function Perl_padlist_dup().

assert() that pads are never AvREAL().

diff --git a/embed.fnc b/embed.fnc
index 57dd568..8e463c1 100644 (file)
--- 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 b328914..90e8045 100644 (file)
--- 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 f941252..99b25c8 100644 (file)
--- 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 0acb1c5..6ccf19c 100644 (file)
--- 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 380f442..0da4256 100644 (file)
--- 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)