From: Nicholas Clark Date: Thu, 18 Oct 2007 09:24:42 +0000 (+0000) Subject: Where possible, change gv_fetchfile() to gv_fetchfile_flags(), X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9bde8eb087a2c05d4c8b0394a59d28a09fe5f529;p=p5sagit%2Fp5-mst-13.2.git Where possible, change gv_fetchfile() to gv_fetchfile_flags(), gv_stashpv() to gv_stashpvn() and gv_fetchpv() to gv_fetchpvn_flags(). Change the len parameter of S_find_in_my_stash() from I32 to STRLEN, as a pointer the variable needs to be passed onwards, and size matters on 64 bit platforms. Fix the temporary scribbling of a buffer in Perl_yylex() by using gv_fetchpvn_flags(), and remove the XXX comment added in change 27641. Brought to you by the Campaign for the Elimination of strlen(). p4raw-id: //depot/perl@32127 --- diff --git a/embed.fnc b/embed.fnc index f6593a9..2f0c2c8 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1548,7 +1548,7 @@ sR |I32 |sublex_done sR |I32 |sublex_push sR |I32 |sublex_start sR |char * |filter_gets |NN SV *sv|NN PerlIO *fp|STRLEN append -sR |HV * |find_in_my_stash|NN const char *pkgname|I32 len +sR |HV * |find_in_my_stash|NN const char *pkgname|STRLEN len sR |char * |tokenize_use |int is_use|NN char *s so |SV* |new_constant |NULLOK const char *s|STRLEN len \ |NN const char *key|STRLEN keylen|NN SV *sv \ diff --git a/gv.c b/gv.c index 1b4816d..a3da747 100644 --- a/gv.c +++ b/gv.c @@ -1426,7 +1426,8 @@ Perl_gv_check(pTHX_ const HV *stash) #ifdef USE_ITHREADS CopFILE(PL_curcop) = (char *)file; /* set for warning */ #else - CopFILEGV(PL_curcop) = gv_fetchfile(file); + CopFILEGV(PL_curcop) + = gv_fetchfile_flags(file, HEK_LEN(GvFILE_HEK(gv)), 0); #endif Perl_warner(aTHX_ packWARN(WARN_ONCE), "Name \"%s::%s\" used only once: possible typo", diff --git a/proto.h b/proto.h index 383990f..8d515af 100644 --- a/proto.h +++ b/proto.h @@ -4120,7 +4120,7 @@ STATIC char * S_filter_gets(pTHX_ SV *sv, PerlIO *fp, STRLEN append) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); -STATIC HV * S_find_in_my_stash(pTHX_ const char *pkgname, I32 len) +STATIC HV * S_find_in_my_stash(pTHX_ const char *pkgname, STRLEN len) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_1); diff --git a/sv.c b/sv.c index bf2e8c8..df7a1b8 100644 --- a/sv.c +++ b/sv.c @@ -9998,10 +9998,10 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param) /** We are joining here so we don't want do clone something that is bad **/ if (SvTYPE(sstr) == SVt_PVHV) { - const char * const hvname = HvNAME_get(sstr); + const HEK * const hvname = HvNAME_HEK(sstr); if (hvname) /** don't clone stashes if they already exist **/ - return (SV*)gv_stashpv(hvname,0); + return (SV*)gv_stashpvn(HEK_KEY(hvname), HEK_LEN(hvname), 0); } } diff --git a/toke.c b/toke.c index eb785cc..fb83407 100644 --- a/toke.c +++ b/toke.c @@ -2934,7 +2934,7 @@ S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append) } STATIC HV * -S_find_in_my_stash(pTHX_ const char *pkgname, I32 len) +S_find_in_my_stash(pTHX_ const char *pkgname, STRLEN len) { dVAR; GV *gv; @@ -2954,10 +2954,10 @@ S_find_in_my_stash(pTHX_ const char *pkgname, I32 len) if (gv && GvCV(gv)) { SV * const sv = cv_const_sv(GvCV(gv)); if (sv) - pkgname = SvPV_nolen_const(sv); + pkgname = SvPV_const(sv, len); } - return gv_stashpv(pkgname, 0); + return gv_stashpvn(pkgname, len, 0); } /* @@ -5109,12 +5109,7 @@ Perl_yylex(pTHX) else if (!isALPHA(*start) && (PL_expect == XTERM || PL_expect == XREF || PL_expect == XSTATE || PL_expect == XTERMORDORDOR)) { - /* XXX Use gv_fetchpvn rather than stomping on a const string */ - const char c = *start; - GV *gv; - *start = '\0'; - gv = gv_fetchpv(s, 0, SVt_PVCV); - *start = c; + GV *const gv = gv_fetchpvn_flags(s, start - s, 0, SVt_PVCV); if (!gv) { s = scan_num(s, &yylval); TERM(THING); @@ -6921,6 +6916,9 @@ S_pending_ident(pTHX) PADOFFSET tmp = 0; /* pit holds the identifier we read and pending_ident is reset */ char pit = PL_pending_ident; + const STRLEN tokenbuf_len = strlen(PL_tokenbuf); + /* All routes through this function want to know if there is a colon. */ + const char *const has_colon = memchr (PL_tokenbuf, ':', tokenbuf_len); PL_pending_ident = 0; /* PL_realtokenstart = realtokenend = PL_bufptr - SvPVX(PL_linestr); */ @@ -6935,14 +6933,14 @@ S_pending_ident(pTHX) */ if (PL_in_my) { if (PL_in_my == KEY_our) { /* "our" is merely analogous to "my" */ - if (strchr(PL_tokenbuf,':')) + if (has_colon) yyerror(Perl_form(aTHX_ "No package name allowed for " "variable %s in \"our\"", PL_tokenbuf)); tmp = allocmy(PL_tokenbuf); } else { - if (strchr(PL_tokenbuf,':')) + if (has_colon) yyerror(Perl_form(aTHX_ PL_no_myglob, PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf)); @@ -6964,7 +6962,7 @@ S_pending_ident(pTHX) (although why you'd do that is anyone's guess). */ - if (!strchr(PL_tokenbuf,':')) { + if (!has_colon) { if (!PL_in_my) tmp = pad_findmy(PL_tokenbuf); if (tmp != NOT_IN_PAD) { @@ -6975,7 +6973,7 @@ S_pending_ident(pTHX) HEK * const stashname = HvNAME_HEK(stash); SV * const sym = newSVhek(stashname); sv_catpvs(sym, "::"); - sv_catpv(sym, PL_tokenbuf+1); + sv_catpvn(sym, PL_tokenbuf+1, tokenbuf_len - 1); yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym); yylval.opval->op_private = OPpCONST_ENTERED; gv_fetchsv(sym, @@ -7018,7 +7016,8 @@ S_pending_ident(pTHX) table. */ if (pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) { - GV *gv = gv_fetchpv(PL_tokenbuf+1, 0, SVt_PVAV); + GV *const gv = gv_fetchpvn_flags(PL_tokenbuf + 1, tokenbuf_len - 1, 0, + SVt_PVAV); if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv))) && ckWARN(WARN_AMBIGUOUS) /* DO NOT warn for @- and @+ */ @@ -7034,10 +7033,11 @@ S_pending_ident(pTHX) } /* build ops for a bareword */ - yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf+1, 0)); + yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpvn(PL_tokenbuf + 1, + tokenbuf_len - 1)); yylval.opval->op_private = OPpCONST_ENTERED; - gv_fetchpv( - PL_tokenbuf+1, + gv_fetchpvn_flags( + PL_tokenbuf + 1, tokenbuf_len - 1, /* If the identifier refers to a stash, don't autovivify it. * Change 24660 had the side effect of causing symbol table * hashes to always be defined, even if they were freshly @@ -7050,7 +7050,9 @@ S_pending_ident(pTHX) * tests still give the expected answers, even though what * they're actually testing has now changed subtly. */ - (*PL_tokenbuf == '%' && *(d = PL_tokenbuf + strlen(PL_tokenbuf) - 1) == ':' && d[-1] == ':' + (*PL_tokenbuf == '%' + && *(d = PL_tokenbuf + tokenbuf_len - 1) == ':' + && d[-1] == ':' ? 0 : PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD), ((PL_tokenbuf[0] == '$') ? SVt_PV