From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 7 Nov 2009 13:37:12 +0000 (+0000)
Subject: Add length and flags arguments to Perl_pad_findmy(), moving it to the public API.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f8f98e0a8bdbde83a9cdc3573d818f69d0a64c78;p=p5sagit%2Fp5-mst-13.2.git
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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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);