Refactor common code paths from Perl_pad_add_name() into S_pad_add_name_sv().

The only user of the pad_add_FAKE flag was S_pad_findlex(), so move the relevant
code there from Perl_pad_add_name(), and have S_pad_findlex() call
S_pad_add_name_sv() directly. This eliminates the pad_add_FAKE flag completely.

diff --git a/embed.fnc b/embed.fnc
index 1a15d5a..1fca12f 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1964,6 +1964,8 @@ pR        |HV*    |pad_compname_type|const PADOFFSET po
 sd     |PADOFFSET|pad_findlex  |NN const char *name|NN const CV* cv|U32 seq|int warn \
                                |NULLOK SV** out_capture|NN SV** out_name_sv \
                                |NN int *out_flags
+s      |PADOFFSET|pad_add_name_sv|NN SV *namesv|const U32 flags \
+                               |NULLOK HV *typestash|NULLOK HV *ourstash
 #  if defined(DEBUGGING)
 sd     |void   |cv_dump        |NN const CV *cv|NN const char *title
 #  endif

diff --git a/embed.h b/embed.h
index 3e9e702..f71e797 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1734,6 +1734,7 @@
 #if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
 #define pad_findlex            S_pad_findlex
+#define pad_add_name_sv                S_pad_add_name_sv
 #endif
 #  if defined(DEBUGGING)
 #ifdef PERL_CORE
@@ -4111,6 +4112,7 @@
 #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)
+#define pad_add_name_sv(a,b,c,d)       S_pad_add_name_sv(aTHX_ a,b,c,d)
 #endif
 #  if defined(DEBUGGING)
 #ifdef PERL_CORE

diff --git a/pad.c b/pad.c
index d80679a..4280c9f 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -339,6 +339,35 @@ Perl_pad_undef(pTHX_ CV* cv)
 
 
 
+static PADOFFSET
+S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typestash,
+                 HV *ourstash)
+{
+    dVAR;
+    const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
+
+    PERL_ARGS_ASSERT_PAD_ADD_NAME_SV;
+
+    ASSERT_CURPAD_ACTIVE("pad_add_name");
+
+    if (typestash) {
+       assert(SvTYPE(namesv) == SVt_PVMG);
+       SvPAD_TYPED_on(namesv);
+       SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
+    }
+    if (ourstash) {
+       SvPAD_OUR_on(namesv);
+       SvOURSTASH_set(namesv, ourstash);
+       SvREFCNT_inc_simple_void_NN(ourstash);
+    }
+    else if (flags & pad_add_STATE) {
+       SvPAD_STATE_on(namesv);
+    }
+
+    av_store(PL_comppad_name, offset, namesv);
+    return offset;
+}
+
 /*
 =for apidoc pad_add_name
 
@@ -359,14 +388,12 @@ Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags,
                  HV *typestash, HV *ourstash)
 {
     dVAR;
-    const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
+    PADOFFSET offset;
     SV *namesv;
 
     PERL_ARGS_ASSERT_PAD_ADD_NAME;
 
-    ASSERT_CURPAD_ACTIVE("pad_add_name");
-
-    if (flags & ~(pad_add_STATE|pad_add_FAKE))
+    if (flags & ~(pad_add_STATE))
        Perl_croak(aTHX_ "panic: pad_add_name illegal flag bits 0x%" UVxf,
                   (UV)flags);
 
@@ -379,46 +406,26 @@ Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags,
 
     sv_setpv(namesv, name);
 
-    if (typestash) {
-       assert(SvTYPE(namesv) == SVt_PVMG);
-       SvPAD_TYPED_on(namesv);
-       SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
-    }
-    if (ourstash) {
-       SvPAD_OUR_on(namesv);
-       SvOURSTASH_set(namesv, ourstash);
-       SvREFCNT_inc_simple_void_NN(ourstash);
-    }
-    else if (flags & pad_add_STATE) {
-       SvPAD_STATE_on(namesv);
-    }
-
-    av_store(PL_comppad_name, offset, namesv);
-    if (flags & pad_add_FAKE) {
-       SvFAKE_on(namesv);
-       DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-           "Pad addname: %ld \"%s\" FAKE\n", (long)offset, name));
-    }
-    else {
-       /* not yet introduced */
-       COP_SEQ_RANGE_LOW_set(namesv, PAD_MAX); /* min */
-       COP_SEQ_RANGE_HIGH_set(namesv, 0);              /* max */
-
-       if (!PL_min_intro_pending)
-           PL_min_intro_pending = offset;
-       PL_max_intro_pending = offset;
-       /* if it's not a simple scalar, replace with an AV or HV */
-       /* XXX DAPM since slot has been allocated, replace
-        * av_store with PL_curpad[offset] ? */
-       if (*name == '@')
-           av_store(PL_comppad, offset, MUTABLE_SV(newAV()));
-       else if (*name == '%')
-           av_store(PL_comppad, offset, MUTABLE_SV(newHV()));
-       SvPADMY_on(PL_curpad[offset]);
-       DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-           "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
-           (long)offset, name, PTR2UV(PL_curpad[offset])));
-    }
+    offset = pad_add_name_sv(namesv, flags, typestash, ourstash);
+
+    /* not yet introduced */
+    COP_SEQ_RANGE_LOW_set(namesv, PAD_MAX);    /* min */
+    COP_SEQ_RANGE_HIGH_set(namesv, 0);         /* max */
+
+    if (!PL_min_intro_pending)
+       PL_min_intro_pending = offset;
+    PL_max_intro_pending = offset;
+    /* if it's not a simple scalar, replace with an AV or HV */
+    /* XXX DAPM since slot has been allocated, replace
+     * av_store with PL_curpad[offset] ? */
+    if (*name == '@')
+       av_store(PL_comppad, offset, MUTABLE_SV(newAV()));
+    else if (*name == '%')
+       av_store(PL_comppad, offset, MUTABLE_SV(newHV()));
+    SvPADMY_on(PL_curpad[offset]);
+    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+                          "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
+                          (long)offset, name, PTR2UV(PL_curpad[offset])));
 
     return offset;
 }
@@ -904,24 +911,30 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
        return 0; /* this dummy (and invalid) value isnt used by the caller */
 
     {
-       SV *new_namesv;
+       /* This relies on sv_setsv_flags() upgrading the destination to the same
+          type as the source, independant of the flags set, and on it being
+          "good" and only copying flag bits and pointers that it understands.
+       */
+       SV *new_namesv = newSVsv(*out_name_sv);
        AV *  const ocomppad_name = PL_comppad_name;
        PAD * const ocomppad = PL_comppad;
        PL_comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
        PL_comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
        PL_curpad = AvARRAY(PL_comppad);
 
-       new_offset = pad_add_name(
-           SvPVX_const(*out_name_sv),
-           SvCUR(*out_name_sv),
-           /* state variable ? */
-           pad_add_FAKE | (SvPAD_STATE(*out_name_sv) ? pad_add_STATE : 0),
-           SvPAD_TYPED(*out_name_sv)
-                   ? SvSTASH(*out_name_sv) : NULL,
-           SvOURSTASH(*out_name_sv)
-       );
-
-       new_namesv = AvARRAY(PL_comppad_name)[new_offset];
+       new_offset
+           = pad_add_name_sv(new_namesv,
+                             (SvPAD_STATE(*out_name_sv) ? pad_add_STATE : 0),
+                             SvPAD_TYPED(*out_name_sv)
+                             ? SvSTASH(*out_name_sv) : NULL,
+                             SvOURSTASH(*out_name_sv)
+                             );
+
+       SvFAKE_on(new_namesv);
+       DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+                              "Pad addname: %ld \"%.*s\" FAKE\n",
+                              (long)new_offset,
+                              (int) SvCUR(new_namesv), SvPVX(new_namesv)));
        PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
 
        PARENT_PAD_INDEX_set(new_namesv, 0);

diff --git a/pad.h b/pad.h
index 074d52e..e6cee11 100644 (file)
--- a/pad.h
+++ b/pad.h
@@ -119,7 +119,6 @@ typedef enum {
 
 #  define pad_add_OUR  0x01    /* our declaration. */
 #  define pad_add_STATE        0x02    /* state declaration. */
-#  define pad_add_FAKE 0x04
 
 #endif
 

diff --git a/proto.h b/proto.h
index 5d326b5..243495b 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6162,6 +6162,11 @@ STATIC PADOFFSET S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, in
 #define PERL_ARGS_ASSERT_PAD_FINDLEX   \
        assert(name); assert(cv); assert(out_name_sv); assert(out_flags)
 
+STATIC PADOFFSET       S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typestash, HV *ourstash)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_PAD_ADD_NAME_SV       \
+       assert(namesv)
+
 #  if defined(DEBUGGING)
 STATIC void    S_cv_dump(pTHX_ const CV *cv, const char *title)
                        __attribute__nonnull__(pTHX_1)