From: Nicholas Clark 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);