Add length and flags arguments to Perl_pad_add_name().

Currently only pad_add_STATE and pad_add_FAKE are used. The length is cross-
checked against strlen() on the pointer, but the intent is to re-work the entire
pad API to be UTF-8 aware, from the current situation of char * pointers only.

diff --git a/embed.fnc b/embed.fnc
index ef8cc8e..ae69dc0 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1933,8 +1933,9 @@ pda       |PADLIST*|pad_new       |int flags
 : Only used in op.c
 pd     |void   |pad_undef      |NN CV* cv
 : Only used in op.c
-pd     |PADOFFSET|pad_add_name |NN const char *name\
-                               |NULLOK HV* typestash|NULLOK HV* ourstash|bool clone|bool state
+Mpd    |PADOFFSET|pad_add_name |NN const char *name|const STRLEN len\
+                               |const U32 flags|NULLOK HV *typestash\
+                               |NULLOK HV *ourstash
 : Only used in op.c
 pd     |PADOFFSET|pad_add_anon |NN SV* sv|OPCODE op_type
 : Only used in op.c

diff --git a/op.c b/op.c
index aa5994d..8293fab 100644 (file)
--- a/op.c
+++ b/op.c
@@ -412,15 +412,14 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
 
     /* allocate a spare slot and store the name in that slot */
 
-    off = pad_add_name(name,
+    off = pad_add_name(name, len,
+                      PL_parser->in_my == KEY_state ? pad_add_STATE : 0,
                    PL_parser->in_my_stash,
                    (is_our
                        /* $_ is always in main::, even with our */
                        ? (PL_curstash && !strEQ(name,"$_") ? PL_curstash : PL_defstash)
                        : NULL
-                   ),
-                   0, /*  not fake */
-                   PL_parser->in_my == KEY_state
+                   )
     );
     /* anon sub prototypes contains state vars should always be cloned,
      * otherwise the state var would be shared between anon subs */

diff --git a/pad.c b/pad.c
index e9c83fe..d80679a 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -355,17 +355,28 @@ If fake, it means we're cloning an existing entry
 */
 
 PADOFFSET
-Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake, bool state)
+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);
-    SV* const namesv
-       = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
+    SV *namesv;
 
     PERL_ARGS_ASSERT_PAD_ADD_NAME;
 
     ASSERT_CURPAD_ACTIVE("pad_add_name");
 
+    if (flags & ~(pad_add_STATE|pad_add_FAKE))
+       Perl_croak(aTHX_ "panic: pad_add_name illegal flag bits 0x%" UVxf,
+                  (UV)flags);
+
+    namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
+
+    /* Until we're using the length for real, cross check that we're being told
+       the truth.  */
+    PERL_UNUSED_ARG(len);
+    assert(strlen(name) == len);
+
     sv_setpv(namesv, name);
 
     if (typestash) {
@@ -378,12 +389,12 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake
        SvOURSTASH_set(namesv, ourstash);
        SvREFCNT_inc_simple_void_NN(ourstash);
     }
-    else if (state) {
+    else if (flags & pad_add_STATE) {
        SvPAD_STATE_on(namesv);
     }
 
     av_store(PL_comppad_name, offset, namesv);
-    if (fake) {
+    if (flags & pad_add_FAKE) {
        SvFAKE_on(namesv);
        DEBUG_Xv(PerlIO_printf(Perl_debug_log,
            "Pad addname: %ld \"%s\" FAKE\n", (long)offset, name));
@@ -902,11 +913,12 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
 
        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),
-           1,  /* fake */
-           SvPAD_STATE(*out_name_sv) ? 1 : 0 /* state variable ? */
+           SvOURSTASH(*out_name_sv)
        );
 
        new_namesv = AvARRAY(PL_comppad_name)[new_offset];

diff --git a/proto.h b/proto.h
index 50f72a1..3aa6ca3 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6101,7 +6101,7 @@ PERL_CALLCONV void        Perl_pad_undef(pTHX_ CV* cv)
 #define PERL_ARGS_ASSERT_PAD_UNDEF     \
        assert(cv)
 
-PERL_CALLCONV PADOFFSET        Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool clone, bool state)
+PERL_CALLCONV PADOFFSET        Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags, HV *typestash, HV *ourstash)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_PAD_ADD_NAME  \
        assert(name)