This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Change some strBEGINs() to memBEGINs()
authorKarl Williamson <khw@cpan.org>
Thu, 2 Nov 2017 20:03:40 +0000 (14:03 -0600)
committerKarl Williamson <khw@cpan.org>
Mon, 6 Nov 2017 19:50:06 +0000 (12:50 -0700)
The latter is generally faster when the length is already known.

This commit also changes a few hard-coded numbers to use sizeof().

gv.c
pp.c
pp_pack.c
regcomp.c
toke.c

diff --git a/gv.c b/gv.c
index 60b8c7d..bdad262 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1073,8 +1073,9 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
            DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
                         origname, HvENAME_get(stash), name) );
        }
-        else if ( sep_len >= 7 &&
-                strBEGINs(last_separator - 7, "::SUPER")) {
+        else if (memBEGINs(last_separator - sizeof("::SUPER") - 1,
+                            sep_len, "::SUPER"))
+        {
             /* don't autovifify if ->NoSuchStash::SUPER::method */
             stash = gv_stashpvn(origname, sep_len - 7, is_utf8);
            if (stash) flags |= GV_SUPER;
diff --git a/pp.c b/pp.c
index 30b8406..130019f 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -384,7 +384,7 @@ PP(pp_prototype)
     if (SvGMAGICAL(TOPs)) SETs(sv_mortalcopy(TOPs));
     if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
        const char * s = SvPVX_const(TOPs);
-       if (strBEGINs(s, "CORE::")) {
+        if (memBEGINs(s, SvCUR(TOPs), "CORE::")) {
            const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1);
            if (!code)
                DIE(aTHX_ "Can't find an opnumber for \"%" UTF8f "\"",
index f2d56b4..7033649 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -191,7 +191,7 @@ S_mul128(pTHX_ SV *sv, U8 m)
 
   PERL_ARGS_ASSERT_MUL128;
 
-  if (! strBEGINs(s, "0000")) {  /* need to grow sv */
+  if (! memBEGINs(s, len, "0000")) {  /* need to grow sv */
     SV * const tmpNew = newSVpvs("0000000000");
 
     sv_catsv(tmpNew, sv);
index e99a563..6fb43d4 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -12059,10 +12059,11 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state,
     if (! endbrace) { /* no trailing brace */
         vFAIL2("Missing right brace on \\%c{}", 'N');
     }
-    else if(!(endbrace == RExC_parse           /* nothing between the {} */
-              || (endbrace - RExC_parse >= 2   /* U+ (bad hex is checked... */
-                  && strBEGINs(RExC_parse, "U+")))) /* ... below for a better
-                                                     error msg) */
+    else if (!(   endbrace == RExC_parse       /* nothing between the {} */
+               || memBEGINs(RExC_parse,   /* U+ (bad hex is checked below
+                                                   for a  better error msg) */
+                                  (STRLEN) (RExC_end - RExC_parse),
+                                 "U+")))
     {
        RExC_parse = endbrace;  /* position msg's '<--HERE' */
        vFAIL("\\N{NAME} must be resolved by the lexer");
diff --git a/toke.c b/toke.c
index 2e6f9ed..5593b6f 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -4877,8 +4877,11 @@ Perl_yylex(pTHX)
            }
            else {
                I32 tmp;
-                if (strBEGINs(s, "L\\u") || strBEGINs(s, "U\\l"))
+                if (   memBEGINs(s, (STRLEN) (PL_bufend - s), "L\\u")
+                    || memBEGINs(s, (STRLEN) (PL_bufend - s), "U\\l"))
+                {
                     tmp = *s, *s = s[2], s[2] = (char)tmp;     /* misordered... */
+                }
                if ((*s == 'L' || *s == 'U' || *s == 'F')
                     && (strpbrk(PL_lex_casestack, "LUF")))
                 {
@@ -5643,7 +5646,7 @@ Perl_yylex(pTHX)
            while (s < PL_bufend && SPACE_OR_TAB(*s))
                s++;
 
-           if (strBEGINs(s,"=>")) {
+           if (memBEGINs(s, (STRLEN) (PL_bufend - s), "=>")) {
                s = force_word(PL_bufptr,BAREWORD,FALSE,FALSE);
                DEBUG_T( { printbuf("### Saw unary minus before =>, forcing word %s\n", s); } );
                OPERATOR('-');          /* unary minus */
@@ -6254,7 +6257,7 @@ Perl_yylex(pTHX)
                        PL_expect = XTERM;
                        break;
                    }
-                   if (strBEGINs(s, "sub")) {
+                   if (memBEGINs(s, (STRLEN) (PL_bufend - s), "sub")) {
                         PL_bufptr = s;
                        d = s + 3;
                        d = skipspace(d);
@@ -6390,7 +6393,9 @@ Perl_yylex(pTHX)
        {
            const char tmp = *s++;
            if (tmp == '=') {
-               if ((s == PL_linestart+2 || s[-3] == '\n') && strBEGINs(s, "=====")) {
+                if (   (s == PL_linestart+2 || s[-3] == '\n')
+                    && memBEGINs(s, (STRLEN) (PL_bufend - s), "====="))
+                {
                    s = vcs_conflict_marker(s + 5);
                    goto retry;
                }
@@ -6510,7 +6515,9 @@ Perl_yylex(pTHX)
            if (s[1] != '<' && !strchr(s,'>'))
                check_uni();
            if (s[1] == '<' && s[2] != '>') {
-               if ((s == PL_linestart || s[-1] == '\n') && strBEGINs(s+2, "<<<<<")) {
+                if (   (s == PL_linestart || s[-1] == '\n')
+                    && memBEGINs(s+2, (STRLEN) (PL_bufend - (s+2)), "<<<<<"))
+                {
                    s = vcs_conflict_marker(s + 7);
                    goto retry;
                }
@@ -6525,7 +6532,9 @@ Perl_yylex(pTHX)
        {
            char tmp = *s++;
            if (tmp == '<') {
-               if ((s == PL_linestart+2 || s[-3] == '\n') && strBEGINs(s, "<<<<<")) {
+                if (   (s == PL_linestart+2 || s[-3] == '\n')
+                    && memBEGINs(s, (STRLEN) (PL_bufend - s), "<<<<<"))
+                {
                     s = vcs_conflict_marker(s + 5);
                    goto retry;
                }
@@ -6569,7 +6578,9 @@ Perl_yylex(pTHX)
        {
            const char tmp = *s++;
            if (tmp == '>') {
-               if ((s == PL_linestart+2 || s[-3] == '\n') && strBEGINs(s, ">>>>>")) {
+               if (   (s == PL_linestart+2 || s[-3] == '\n')
+                    && memBEGINs(s, (STRLEN) (PL_bufend - s), ">>>>>"))
+                {
                    s = vcs_conflict_marker(s + 5);
                    goto retry;
                }
@@ -9369,7 +9380,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
             || isDIGIT_A((U8)s[1])
             || s[1] == '$'
             || s[1] == '{'
-            || strBEGINs(s+1,"::")) )
+            || memBEGINs(s+1, (STRLEN) (PL_bufend - (s+1)), "::")) )
     {
         /* Dereferencing a value in a scalar variable.
            The alternatives are different syntaxes for a scalar variable.
@@ -11724,12 +11735,11 @@ S_swallow_bom(pTHX_ U8 *s)
        }
        break;
     case BOM_UTF8_FIRST_BYTE: {
-        const STRLEN len = sizeof(BOM_UTF8_TAIL) - 1; /* Exclude trailing NUL */
-        if (slen > len && memEQ(s+1, BOM_UTF8_TAIL, len)) {
+        if (memBEGINs(s+1, slen - 1, BOM_UTF8_TAIL)) {
 #ifdef DEBUGGING
             if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-8 script encoding (BOM)\n");
 #endif
-            s += len + 1;                      /* UTF-8 */
+            s += sizeof(BOM_UTF8) - 1;                     /* UTF-8 */
         }
         break;
     }