Add length and flags arguments to Perl_pad_findmy(), moving it to the public API.

Currently no flags bits are used, and 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 493f9c9..cbea291 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -745,7 +745,7 @@ pd  |PADOFFSET|pad_alloc    |I32 optype|U32 tmptype
 : Used in toke.c and perly.y
 p      |PADOFFSET|allocmy      |NN const char *const name
 : Used in op.c and toke.c
-EXpdR  |PADOFFSET|pad_findmy   |NN const char* name
+AMpdR  |PADOFFSET|pad_findmy   |NN const char* name|STRLEN len|U32 flags
 Ap     |PADOFFSET|find_rundefsvoffset  |
 : Used in perly.y
 pR     |OP*    |oopsAV         |NN OP* o

diff --git a/embed.h b/embed.h
index 9455afc..636a87b 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -639,9 +639,7 @@
 #define pad_alloc              Perl_pad_alloc
 #define allocmy                        Perl_allocmy
 #endif
-#if defined(PERL_CORE) || defined(PERL_EXT)
 #define pad_findmy             Perl_pad_findmy
-#endif
 #define find_rundefsvoffset    Perl_find_rundefsvoffset
 #ifdef PERL_CORE
 #define oopsAV                 Perl_oopsAV
@@ -3009,9 +3007,7 @@
 #define pad_alloc(a,b)         Perl_pad_alloc(aTHX_ a,b)
 #define allocmy(a)             Perl_allocmy(aTHX_ a)
 #endif
-#if defined(PERL_CORE) || defined(PERL_EXT)
-#define pad_findmy(a)          Perl_pad_findmy(aTHX_ a)
-#endif
+#define pad_findmy(a,b,c)      Perl_pad_findmy(aTHX_ a,b,c)
 #define find_rundefsvoffset()  Perl_find_rundefsvoffset(aTHX)
 #ifdef PERL_CORE
 #define oopsAV(a)              Perl_oopsAV(aTHX_ a)

diff --git a/ext/XS-APItest-KeywordRPN/KeywordRPN.xs b/ext/XS-APItest-KeywordRPN/KeywordRPN.xs
index 32b6998..22eedc7 100644 (file)
--- a/ext/XS-APItest-KeywordRPN/KeywordRPN.xs
+++ b/ext/XS-APItest-KeywordRPN/KeywordRPN.xs
@@ -66,7 +66,7 @@ static OP *THX_parse_var(pTHX)
                sv_catpvn_nomg(varname, &c, 1);
        }
        if(SvCUR(varname) < 2) Perl_croak(aTHX_ "RPN syntax error");
-       varpos = pad_findmy(SvPVX(varname));
+       varpos = pad_findmy(SvPVX(varname), SvCUR(varname), 0);
        if(varpos == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(varpos))
                Perl_croak(aTHX_ "RPN only supports \"my\" variables");
        padop = newOP(OP_PADSV, 0);

diff --git a/op.c b/op.c
index 504fae9..1e869c1 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2281,7 +2281,7 @@ STATIC OP *
 S_newDEFSVOP(pTHX)
 {
     dVAR;
-    const PADOFFSET offset = pad_findmy("$_");
+    const PADOFFSET offset = Perl_pad_findmy(aTHX_ STR_WITH_LEN("$_"), 0);
     if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
        return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
     }
@@ -4995,7 +4995,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
        }
     }
     else {
-        const PADOFFSET offset = pad_findmy("$_");
+        const PADOFFSET offset = Perl_pad_findmy(aTHX_ STR_WITH_LEN("$_"), 0);
        if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
            sv = newGVOP(OP_GV, 0, PL_defgv);
        }
@@ -7166,7 +7166,7 @@ Perl_ck_grep(pTHX_ OP *o)
     gwop->op_flags |= OPf_KIDS;
     gwop->op_other = LINKLIST(kid);
     kid->op_next = (OP*)gwop;
-    offset = pad_findmy("$_");
+    offset = Perl_pad_findmy(aTHX_ STR_WITH_LEN("$_"), 0);
     if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
        o->op_private = gwop->op_private = 0;
        gwop->op_targ = pad_alloc(type, SVs_PADTMP);
@@ -7406,7 +7406,7 @@ Perl_ck_match(pTHX_ OP *o)
     PERL_ARGS_ASSERT_CK_MATCH;
 
     if (o->op_type != OP_QR && PL_compcv) {
-       const PADOFFSET offset = pad_findmy("$_");
+       const PADOFFSET offset = Perl_pad_findmy(aTHX_ STR_WITH_LEN("$_"), 0);
        if (offset != NOT_IN_PAD && !(PAD_COMPNAME_FLAGS_isOUR(offset))) {
            o->op_targ = offset;
            o->op_private |= OPpTARGET_MY;

diff --git a/pad.c b/pad.c
index 2e0b863..ae69c9e 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -612,7 +612,7 @@ Returns the offset in the current pad, or NOT_IN_PAD on failure.
 */
 
 PADOFFSET
-Perl_pad_findmy(pTHX_ const char *name)
+Perl_pad_findmy(pTHX_ const char *name, STRLEN len, U32 flags)
 {
     dVAR;
     SV *out_sv;
@@ -624,6 +624,22 @@ Perl_pad_findmy(pTHX_ const char *name)
     PERL_ARGS_ASSERT_PAD_FINDMY;
 
     pad_peg("pad_findmy");
+
+    if (flags)
+       Perl_croak(aTHX_ "panic: pad_findmy illegal flag bits 0x%" UVxf,
+                  (UV)flags);
+
+    /* Yes, it is a bug (read work in progress) that we're not really using this
+       length parameter, and instead relying on strlen() later on. But I'm not
+       comfortable about changing the pad API piecemeal to use and rely on
+       lengths. This only exists to avoid an "unused parameter" warning.  */
+    if (len < 2) 
+       return NOT_IN_PAD;
+
+    /* But until we're using the length for real, cross check that we're being
+       told the truth.  */
+    assert(strlen(name) == len);
+
     offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
                NULL, &out_sv, &out_flags);
     if ((PADOFFSET)offset != NOT_IN_PAD) 

diff --git a/proto.h b/proto.h
index 353f9c3..c3322b8 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2357,7 +2357,7 @@ PERL_CALLCONV PADOFFSET   Perl_allocmy(pTHX_ const char *const name)
 #define PERL_ARGS_ASSERT_ALLOCMY       \
        assert(name)
 
-PERL_CALLCONV PADOFFSET        Perl_pad_findmy(pTHX_ const char* name)
+PERL_CALLCONV PADOFFSET        Perl_pad_findmy(pTHX_ const char* name, STRLEN len, U32 flags)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_PAD_FINDMY    \

diff --git a/toke.c b/toke.c
index c18adea..0bfa970 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -7110,7 +7110,7 @@ S_pending_ident(pTHX)
 
     if (!has_colon) {
        if (!PL_in_my)
-           tmp = pad_findmy(PL_tokenbuf);
+           tmp = pad_findmy(PL_tokenbuf, tokenbuf_len, 0);
         if (tmp != NOT_IN_PAD) {
             /* might be an "our" variable" */
             if (PAD_COMPNAME_FLAGS_isOUR(tmp)) {
@@ -11618,7 +11618,7 @@ S_scan_inputsymbol(pTHX_ char *start)
            /* try to find it in the pad for this block, otherwise find
               add symbol table ops
            */
-           const PADOFFSET tmp = pad_findmy(d);
+           const PADOFFSET tmp = pad_findmy(d, len, 0);
            if (tmp != NOT_IN_PAD) {
                if (PAD_COMPNAME_FLAGS_isOUR(tmp)) {
                    HV * const stash = PAD_COMPNAME_OURSTASH(tmp);