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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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