This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add memCHRs() macro and use it
authorKarl Williamson <khw@cpan.org>
Sat, 7 Dec 2019 20:47:05 +0000 (13:47 -0700)
committerKarl Williamson <khw@cpan.org>
Wed, 18 Dec 2019 16:33:09 +0000 (09:33 -0700)
This replaces strchr("list", c) calls throughout the core.  They don't
work properly when 'c' is a NUL, returning the position of the
terminating NUL in "list" instead of failure.  This could lead to
segfaults or even security issues.

23 files changed:
amigaos4/amigaio.c
doio.c
ext/B/B.pm
ext/B/B.xs
ext/VMS-Stdio/Stdio.pm
ext/VMS-Stdio/Stdio.xs
handy.h
numeric.c
op.c
os2/dl_os2.c
os2/os2.c
perl.c
pod/perlhacktips.pod
pp_hot.c
pp_pack.c
regcomp.c
sv.c
t/porting/known_pod_issues.dat
taint.c
toke.c
util.c
util.h
vms/vms.c

index edc237a..58964f9 100644 (file)
@@ -682,7 +682,7 @@ static I32 S_do_amigaos_exec3(pTHX_ const char *incmd, int fd, int do_report)
        for (s = cmd; *s; s++)
        {
                if (*s != ' ' && !isALPHA(*s) &&
-                       strchr("$&*(){}[]'\";\\|?<>~`\n", *s))
+                       memCHRs("$&*(){}[]'\";\\|?<>~`\n", *s))
                {
                        if (*s == '\n' && !s[1])
                        {
diff --git a/doio.c b/doio.c
index 424e0e3..c57750e 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -2419,7 +2419,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 
     for (s = cmd; *s; s++) {
        if (*s != ' ' && !isALPHA(*s) &&
-           strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
+           memCHRs("$&*(){}[]'\";\\|?<>~`\n",*s)) {
            if (*s == '\n' && !s[1]) {
                *s = '\0';
                break;
index 8ee5a12..8eb749c 100644 (file)
@@ -20,7 +20,7 @@ sub import {
 # walkoptree comes from B.xs
 
 BEGIN {
-    $B::VERSION = '1.77';
+    $B::VERSION = '1.78';
     @B::EXPORT_OK = ();
 
     # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
index d27eba3..7bd8353 100644 (file)
@@ -258,7 +258,7 @@ cstring(pTHX_ SV *sv, bool perlstyle)
                sv_catpvs(sstr, "\\@");
            else if (*s == '\\')
            {
-               if (strchr("nrftax\\",*(s+1)))
+               if (memCHRs("nrftax\\",*(s+1)))
                    sv_catpvn(sstr, s++, 2);
                else
                    sv_catpvs(sstr, "\\\\");
index 02ba866..53c5f30 100644 (file)
@@ -12,7 +12,7 @@ use Carp '&croak';
 use DynaLoader ();
 use Exporter ();
 
-our $VERSION = '2.44';
+our $VERSION = '2.45';
 our @ISA = qw( Exporter DynaLoader IO::File );
 our @EXPORT = qw( &O_APPEND &O_CREAT &O_EXCL  &O_NDELAY &O_NOWAIT
               &O_RDONLY &O_RDWR  &O_TRUNC &O_WRONLY );
index 64e1ef3..953f82c 100644 (file)
@@ -137,7 +137,7 @@ binmode(fh)
           io = sv_2io(fh);
            fp = io ? IoOFP(io) : NULL;
           iotype = io ? IoTYPE(io) : '\0';
-           if (fp == NULL || strchr(">was+-|",iotype) == NULL) {
+           if (fp == NULL || memCHRs(">was+-|",iotype) == NULL) {
              set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN); XSRETURN_UNDEF;
            }
            if (!PerlIO_getname(fp,filespec)) XSRETURN_UNDEF;
@@ -432,7 +432,7 @@ writeof(mysv)
            struct dsc$descriptor devdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, devnam};
            IO *io = sv_2io(mysv);
            PerlIO *fp = io ? IoOFP(io) : NULL;
-           if (fp == NULL || strchr(">was+-|",IoTYPE(io)) == NULL) {
+           if (fp == NULL || memCHRs(">was+-|",IoTYPE(io)) == NULL) {
              set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN); XSRETURN_UNDEF;
            }
            if (PerlIO_getname(fp,devnam) == NULL) { ST(0) = &PL_sv_undef; XSRETURN(1); }
diff --git a/handy.h b/handy.h
index f10136f..8da2a15 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -478,6 +478,13 @@ Like L</memNE>, but the second string is a literal enclosed in double quotes,
 C<l1> gives the number of bytes in C<s1>.
 Returns zero if non-equal, or zero if non-equal.
 
+=for apidoc Am|bool|memCHRs|"list"|char c
+Returns the position of the first occurence of the byte C<c> in the literal
+string C<"list">, or NULL if C<c> doesn't appear in C<"list">.  All bytes are
+treated as unsigned char.  Thus this macro can be used to determine if C<c> is
+in a set of particular characters.  Unlike L<strchr(3)>, it works even if C<c>
+is C<NUL> (and the set doesn't include C<NUL>).
+
 =cut
 
 New macros should use the following conventions for their names (which are
@@ -569,6 +576,8 @@ based on the underlying C library functions):
 #define memGT(s1,s2,l) (memcmp(s1,s2,l) > 0)
 #define memGE(s1,s2,l) (memcmp(s1,s2,l) >= 0)
 
+#define memCHRs(s1,c) ((const char *) memchr("" s1 "" , c, sizeof(s1)-1))
+
 /*
  * Character classes.
  *
index 0b8677d..23cc104 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -1150,7 +1150,7 @@ Perl_grok_number_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, U32 flags)
     return IS_NUMBER_IN_UV;
   }
   /* We could be e.g. at "Inf" or "NaN", or at the "#" of "1.#INF". */
-  if ((s + 2 < send) && strchr("inqs#", toFOLD(*s))) {
+  if ((s + 2 < send) && memCHRs("inqs#", toFOLD(*s))) {
       /* Really detect inf/nan. Start at d, not s, since the above
        * code might have already consumed the "1." or "1". */
       const int infnan = Perl_grok_infnan(aTHX_ &d, send);
diff --git a/op.c b/op.c
index 07a60f6..c1de4dd 100644 (file)
--- a/op.c
+++ b/op.c
@@ -711,7 +711,7 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
 
        if (!(flags & SVf_UTF8 && UTF8_IS_START(name[1]))
         && isASCII(name[1])
-        && (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1]))) {
+        && (!isPRINT(name[1]) || memCHRs("\t\n\r\f", name[1]))) {
            /* diag_listed_as: Can't use global %s in %s */
            yyerror(Perl_form(aTHX_ "Can't use global %c^%c%.*s in %s",
                              name[0], toCTRL(name[1]),
@@ -5766,18 +5766,18 @@ Perl_localize(pTHX_ OP *o, I32 lex)
            bool sigil = FALSE;
 
            /* some heuristics to detect a potential error */
-           while (*s && (strchr(", \t\n", *s)))
+           while (*s && (memCHRs(", \t\n", *s)))
                s++;
 
            while (1) {
-               if (*s && (strchr("@$%", *s) || (!lex && *s == '*'))
+               if (*s && (memCHRs("@$%", *s) || (!lex && *s == '*'))
                       && *++s
                       && (isWORDCHAR(*s) || UTF8_IS_CONTINUED(*s))) {
                    s++;
                    sigil = TRUE;
                    while (*s && (isWORDCHAR(*s) || UTF8_IS_CONTINUED(*s)))
                        s++;
-                   while (*s && (strchr(", \t\n", *s)))
+                   while (*s && (memCHRs(", \t\n", *s)))
                        s++;
                }
                else
@@ -14364,7 +14364,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
                continue;
            case '_':
                /* _ must be at the end */
-               if (proto[1] && !strchr(";@%", proto[1]))
+               if (proto[1] && !memCHRs(";@%", proto[1]))
                    goto oops;
                 /* FALLTHROUGH */
            case '$':
index 76fa9dc..f15c465 100644 (file)
@@ -121,7 +121,7 @@ dlopen(const char *path, int mode)
        /* Not found. Check for non-FAT name and try truncated name. */
        /* Don't know if this helps though... */
        for (beg = dot = path + strlen(path);
-            beg > path && !strchr(":/\\", *(beg-1));
+            beg > path && !memCHRs(":/\\", *(beg-1));
             beg--)
                if (*beg == '.')
                        dot = beg;
index ae987cb..0c9fa17 100644 (file)
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -1400,7 +1400,7 @@ do_spawn3(pTHX_ char *cmd, int execf, int flag)
        goto doshell;
 
     for (s = cmd; *s; s++) {
-       if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
+       if (*s != ' ' && !isALPHA(*s) && memCHRs("$&*(){}[]'\";\\|?<>~`\n",*s)) {
            if (*s == '\n' && s[1] == '\0') {
                *s = '\0';
                break;
diff --git a/perl.c b/perl.c
index 70424cd..12babb4 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2336,7 +2336,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                d = s;
                if (!*s)
                    break;
-               if (!strchr("CDIMUdmtwW", *s))
+               if (!memCHRs("CDIMUdmtwW", *s))
                    Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
                while (++s && *s) {
                    if (isSPACE(*s)) {
index da15547..8819068 100644 (file)
@@ -648,6 +648,39 @@ you have to pass its length to C<newSVpv>.
 
 =item *
 
+Perl strings are NOT the same as C strings:  They may contain C<NUL>
+characters, whereas a C string is terminated by the first C<NUL>.
+That is why Perl API functions that deal with strings generally take a
+pointer to the first byte and either a length or a pointer to the byte
+just beyond the final one.
+
+And this is the reason that many of the C library string handling
+functions should not be used.  They don't cope with the full generality
+of Perl strings.  It may be that your test cases don't have embedded
+C<NUL>s, and so the tests pass, whereas there may well eventually arise
+real-world cases where they fail.  A lesson here is to include C<NUL>s
+in your tests.  Now it's fairly rare in most real world cases to get
+C<NUL>s, so your code may seem to work, until one day a C<NUL> comes
+along.
+
+Here's an example.  It used to be a common paradigm, for decades, in the
+perl core to use S<C<strchr("list", c)>> to see if the character C<c> is
+any of the ones given in C<"list">, a double-quote-enclosed string of
+the set of characters that we are seeing if C<c> is one of.  As long as
+C<c> isn't a C<NUL>, it works.  But when C<c> is a C<NUL>, C<strchr>
+returns a pointer to the terminating C<NUL> in C<"list">.   This likely
+will result in a segfault or a security issue when the caller uses that
+end pointer as the starting point to read from.
+
+A solution to this and many similar issues is to use the C<mem>I<-foo> C
+library functions instead.  In this case C<memchr> can be used to see if
+C<c> is in C<"list"> and works even if C<c> is C<NUL>.  These functions
+need an additional parameter to give the string length.
+In the case of literal string parameters, perl has defined macros that
+calculate the length for you.  See L<perlapi/Miscellaneous Functions>.
+
+=item *
+
 malloc(0), realloc(0), calloc(0, 0) are non-portable.  To be portable
 allocate at least one byte.  (In general you should rarely need to work
 at this low level, but instead use the various malloc wrappers.)
index 2df5df8..b95ac50 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -3269,9 +3269,9 @@ Perl_do_readline(pTHX)
            }
            for (t1 = SvPVX_const(sv); *t1; t1++)
 #ifdef __VMS
-               if (strchr("*%?", *t1))
+               if (memCHRs("*%?", *t1))
 #else
-               if (strchr("$&*(){}[]'\";\\|?<>~`", *t1))
+               if (memCHRs("$&*(){}[]'\";\\|?<>~`", *t1))
 #endif
                        break;
            if (*t1 && PerlLIO_lstat(SvPVX_const(sv), &statbuf) < 0) {
index 33cb086..6479398 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -1779,9 +1779,9 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
        } /* End of switch */
 
        if (checksum) {
-           if (strchr("fFdD", TYPE_NO_MODIFIERS(datumtype)) ||
+           if (memCHRs("fFdD", TYPE_NO_MODIFIERS(datumtype)) ||
              (checksum > bits_in_uv &&
-              strchr("cCsSiIlLnNUWvVqQjJ", TYPE_NO_MODIFIERS(datumtype))) ) {
+              memCHRs("cCsSiIlLnNUWvVqQjJ", TYPE_NO_MODIFIERS(datumtype))) ) {
                NV trouble, anv;
 
                 anv = (NV) (1 << (checksum & 15));
@@ -2135,7 +2135,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 
         switch (howlen) {
          case e_star:
-           len = strchr("@Xxu", TYPE_NO_MODIFIERS(datumtype)) ?
+           len = memCHRs("@Xxu", TYPE_NO_MODIFIERS(datumtype)) ?
                0 : items;
            break;
          default:
@@ -2160,7 +2160,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
        if (symptr->flags & FLAG_SLASH) {
            IV count;
            if (!found) Perl_croak(aTHX_ "Code missing after '/' in pack");
-           if (strchr("aAZ", lookahead.code)) {
+           if (memCHRs("aAZ", lookahead.code)) {
                if (lookahead.howlen == e_number) count = lookahead.length;
                else {
                    if (items > 0) {
index 4320fc2..5712015 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -114,7 +114,7 @@ typedef struct scan_frame {
 
 /* Certain characters are output as a sequence with the first being a
  * backslash. */
-#define isBACKSLASHED_PUNCT(c)  strchr("-[]\\^", c)
+#define isBACKSLASHED_PUNCT(c)  memCHRs("-[]\\^", c)
 
 
 struct RExC_state_t {
@@ -10722,7 +10722,7 @@ S_parse_lparen_question_flags(pTHX_ RExC_state_t *pRExC_state)
     }
 
     while (RExC_parse < RExC_end) {
-        /* && strchr("iogcmsx", *RExC_parse) */
+        /* && memCHRs("iogcmsx", *RExC_parse) */
         /* (?g), (?gc) and (?o) are useless here
            and must be globally applied -- japhy */
         switch (*RExC_parse) {
@@ -23327,7 +23327,7 @@ Perl_parse_uniprop_string(pTHX_
                  * set of closing is so that if the opening is something like
                  * ']', the closing will be that as well.  Something similar is
                  * done in toke.c */
-                pos_in_brackets = strchr("([<)]>)]>", open);
+                pos_in_brackets = memCHRs("([<)]>)]>", open);
                 close = (pos_in_brackets) ? pos_in_brackets[3] : open;
 
                 if (    i >= name_len
diff --git a/sv.c b/sv.c
index 46d6b25..49ee5cd 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -12361,7 +12361,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
            goto string;
        }
 
-       if (vectorize && !strchr("BbDdiOouUXx", c))
+       if (vectorize && !memCHRs("BbDdiOouUXx", c))
             goto unknown;
 
         /* get next arg (individual branches do their own va_arg()
index 85ca853..b0d2405 100644 (file)
@@ -295,6 +295,7 @@ SOM
 splain
 sprintf(3)
 stat(2)
+strchr(3)
 strftime(3)
 strictures
 String::Base
diff --git a/taint.c b/taint.c
index 871d89f..5834548 100644 (file)
--- a/taint.c
+++ b/taint.c
@@ -170,7 +170,7 @@ Perl_taint_env(pTHX)
 #endif
        if (t < e && isWORDCHAR(*t))
            t++;
-       while (t < e && (isWORDCHAR(*t) || strchr("-_.+", *t)))
+       while (t < e && (isWORDCHAR(*t) || memCHRs("-_.+", *t)))
            t++;
        if (t < e) {
            TAINT;
diff --git a/toke.c b/toke.c
index 46fa0ac..5a4c022 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -113,7 +113,7 @@ static const char* const ident_too_long = "Identifier too long";
 
 /* In variables named $^X, these are the legal values for X.
  * 1999-02-27 mjd-perl-patch@plover.com */
-#define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
+#define isCONTROLVAR(x) (isUPPER(x) || memCHRs("[\\]^_?", (x)))
 
 #define SPACE_OR_TAB(c) isBLANK_A(c)
 
@@ -1647,11 +1647,11 @@ Perl_validate_proto(pTHX_ SV *name, SV *proto, bool warn, bool curstash)
            if (must_be_last)
                proto_after_greedy_proto = TRUE;
            if (underscore) {
-               if (!strchr(";@%", *p))
+               if (!memCHRs(";@%", *p))
                    bad_proto_after_underscore = TRUE;
                underscore = FALSE;
            }
-           if (!strchr("$@%*;[]&\\_+", *p) || *p == '\0') {
+           if (!memCHRs("$@%*;[]&\\_+", *p) || *p == '\0') {
                bad_proto = TRUE;
            }
            else {
@@ -2015,7 +2015,7 @@ S_force_next(pTHX_ I32 type)
 static int
 S_postderef(pTHX_ int const funny, char const next)
 {
-    assert(funny == DOLSHARP || strchr("$@%&*", funny));
+    assert(funny == DOLSHARP || memCHRs("$@%&*", funny));
     if (next == '*') {
        PL_expect = XOPERATOR;
        if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) {
@@ -3445,7 +3445,7 @@ S_scan_const(pTHX_ char *start)
             {
                break;
             }
-           if (strchr(":'{$", s[1]))
+           if (memCHRs(":'{$", s[1]))
                break;
            if (!PL_lex_inpat && (s[1] == '+' || s[1] == '-'))
                break; /* in regexp, neither @+ nor @- are interpolated */
@@ -3455,7 +3455,7 @@ S_scan_const(pTHX_ char *start)
        else if (*s == '$') {
            if (!PL_lex_inpat)  /* not a regexp, so $ must be var */
                break;
-           if (s + 1 < send && !strchr("()| \r\n\t", s[1])) {
+           if (s + 1 < send && !memCHRs("()| \r\n\t", s[1])) {
                if (s[1] == '\\') {
                    Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
                                   "Possible unintended interpolation of $\\ in regex");
@@ -3492,7 +3492,7 @@ S_scan_const(pTHX_ char *start)
            }
 
            /* string-change backslash escapes */
-           if (PL_lex_inwhat != OP_TRANS && *s && strchr("lLuUEQF", *s)) {
+           if (PL_lex_inwhat != OP_TRANS && *s && memCHRs("lLuUEQF", *s)) {
                --s;
                break;
            }
@@ -4205,7 +4205,7 @@ S_intuit_more(pTHX_ char *s, char *e)
     if (*s == '-' && s[1] == '>'
      && FEATURE_POSTDEREF_QQ_IS_ENABLED
      && ( (s[2] == '$' && (s[3] == '*' || (s[3] == '#' && s[4] == '*')))
-       ||(s[2] == '@' && strchr("*[{",s[3])) ))
+       ||(s[2] == '@' && memCHRs("*[{",s[3])) ))
        return TRUE;
     if (*s != '{' && *s != '[')
        return FALSE;
@@ -4270,9 +4270,9 @@ S_intuit_more(pTHX_ char *s, char *e)
                }
                else if (*s == '$'
                          && s[1]
-                         && strchr("[#!%*<>()-=",s[1]))
+                         && memCHRs("[#!%*<>()-=",s[1]))
                 {
-                   if (/*{*/ strchr("])} =",s[2]))
+                   if (/*{*/ memCHRs("])} =",s[2]))
                        weight -= 10;
                    else
                        weight -= 1;
@@ -4281,11 +4281,11 @@ S_intuit_more(pTHX_ char *s, char *e)
            case '\\':
                un_char = 254;
                if (s[1]) {
-                   if (strchr("wds]",s[1]))
+                   if (memCHRs("wds]",s[1]))
                        weight += 100;
                    else if (seen[(U8)'\''] || seen[(U8)'"'])
                        weight += 1;
-                   else if (strchr("rnftbxcav",s[1]))
+                   else if (memCHRs("rnftbxcav",s[1]))
                        weight += 40;
                    else if (isDIGIT(s[1])) {
                        weight += 40;
@@ -4299,9 +4299,9 @@ S_intuit_more(pTHX_ char *s, char *e)
            case '-':
                if (s[1] == '\\')
                    weight += 50;
-               if (strchr("aA01! ",last_un_char))
+               if (memCHRs("aA01! ",last_un_char))
                    weight += 30;
-               if (strchr("zZ79~",s[1]))
+               if (memCHRs("zZ79~",s[1]))
                    weight += 30;
                if (last_un_char == 255 && (isDIGIT(s[1]) || s[1] == '$'))
                    weight -= 5;        /* cope with negative subscript */
@@ -4729,10 +4729,10 @@ S_tokenize_use(pTHX_ int is_use, char *s) {
 STATIC bool
 S_word_takes_any_delimiter(char *p, STRLEN len)
 {
-    return (len == 1 && strchr("msyq", p[0]))
+    return (len == 1 && memCHRs("msyq", p[0]))
             || (len == 2
                 && ((p[0] == 't' && p[1] == 'r')
-                    || (p[0] == 'q' && strchr("qwxr", p[1]))));
+                    || (p[0] == 'q' && memCHRs("qwxr", p[1]))));
 }
 
 static void
@@ -4747,7 +4747,7 @@ S_check_scalar_slice(pTHX_ char *s)
        return;
     }
     while (    isWORDCHAR_lazy_if_safe(s, PL_bufend, UTF)
-           || (*s && strchr(" \t$#+-'\"", *s)))
+           || (*s && memCHRs(" \t$#+-'\"", *s)))
     {
         s += UTF ? UTF8SKIP(s) : 1;
     }
@@ -4795,7 +4795,7 @@ yyl_sigvar(pTHX_ char *s)
     case '@':
     case '%':
         /* spot stuff that looks like an prototype */
-        if (strchr("$:@%&*;\\[]", *s)) {
+        if (memCHRs("$:@%&*;\\[]", *s)) {
             yyerror("Illegal character following sigil in a subroutine signature");
             break;
         }
@@ -4823,7 +4823,7 @@ yyl_sigvar(pTHX_ char *s)
         /* parse the = for the default ourselves to avoid '+=' etc being accepted here
          * as the ASSIGNOP, and exclude other tokens that start with =
          */
-        if (*s == '=' && (!s[1] || strchr("=~>", s[1]) == 0)) {
+        if (*s == '=' && (!s[1] || memCHRs("=~>", s[1]) == 0)) {
             /* save now to report with the same context as we did when
              * all ASSIGNOPS were accepted */
             PL_oldbufptr = s;
@@ -4886,7 +4886,7 @@ yyl_dollar(pTHX_ char *s)
 
     if (   s[1] == '#'
         && (   isIDFIRST_lazy_if_safe(s+2, PL_bufend, UTF)
-            || strchr("{$:+-@", s[2])))
+            || memCHRs("{$:+-@", s[2])))
     {
         PL_tokenbuf[0] = '@';
         s = scan_ident(s + 1, PL_tokenbuf + 1,
@@ -4987,9 +4987,9 @@ yyl_dollar(pTHX_ char *s)
             const bool islop = (PL_last_lop == PL_oldoldbufptr);
             if (!islop || PL_last_lop_op == OP_GREPSTART)
                 PL_expect = XOPERATOR;
-            else if (strchr("$@\"'`q", *s))
+            else if (memCHRs("$@\"'`q", *s))
                 PL_expect = XTERM;             /* e.g. print $fh "foo" */
-            else if (   strchr("&*<%", *s)
+            else if (   memCHRs("&*<%", *s)
                      && isIDFIRST_lazy_if_safe(s+1, PL_bufend, UTF))
             {
                 PL_expect = XTERM;             /* e.g. print $fh &sub */
@@ -5463,7 +5463,7 @@ yyl_hyphen(pTHX_ char *s)
             s = skipspace(s);
             if (((*s == '$' || *s == '&') && s[1] == '*')
               ||(*s == '$' && s[1] == '#' && s[2] == '*')
-              ||((*s == '@' || *s == '%') && strchr("*[{", s[1]))
+              ||((*s == '@' || *s == '%') && memCHRs("*[{", s[1]))
               ||(*s == '*' && (s[1] == '*' || s[1] == '{'))
              )
             {
@@ -5959,7 +5959,7 @@ yyl_leftcurly(pTHX_ char *s, const U8 formbrack)
                     }
                     term = *t;
                     open = term;
-                    if (term && (tmps = strchr("([{< )]}> )]}>",term)))
+                    if (term && (tmps = memCHRs("([{< )]}> )]}>",term)))
                         term = tmps[5];
                     close = term;
                     if (open == close)
@@ -6968,7 +6968,7 @@ yyl_fake_eof(pTHX_ U32 fake_eof, bool bof, char *s, STRLEN len)
              */
             if (d && *s != '#') {
                 const char *c = ipath;
-                while (*c && !strchr("; \t\r\n\f\v#", *c))
+                while (*c && !memCHRs("; \t\r\n\f\v#", *c))
                     c++;
                 if (c < d)
                     d = NULL;  /* "perl" not in first word; ignore */
@@ -7916,7 +7916,7 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct
             char *d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
             for (t=d; isSPACE(*t);)
                 t++;
-            if ( *t && strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE)
+            if ( *t && memCHRs("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE)
                 /* [perl #16184] */
                 && !(t[0] == '=' && t[1] == '>')
                 && !(t[0] == ':' && t[1] == ':')
@@ -8733,7 +8733,7 @@ yyl_try(pTHX_ char *s, STRLEN len)
            if (tmp == '~')
                PMop(OP_MATCH);
            if (tmp && isSPACE(*s) && ckWARN(WARN_SYNTAX)
-               && strchr("+-*/%.^&|<",tmp))
+               && memCHRs("+-*/%.^&|<",tmp))
                Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                            "Reversed %c= operator",(int)tmp);
            s--;
@@ -9479,7 +9479,7 @@ S_checkcomma(pTHX_ const char *s, const char *name, const char *what)
             * block / parens, boolean operators (&&, ||, //) and branch
             * constructs (or, and, if, until, unless, while, err, for).
             * Not a very solid hack... */
-           if (!*w || !strchr(";&/|})]oaiuwef!=", *w))
+           if (!*w || !memCHRs(";&/|})]oaiuwef!=", *w))
                Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                            "%s (...) interpreted as function",name);
        }
@@ -11753,7 +11753,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
        /* read exponent part, if present */
        if ((isALPHA_FOLD_EQ(*s, 'e')
               || UNLIKELY(hexfp && isALPHA_FOLD_EQ(*s, 'p')))
-            && strchr("+-0123456789_", s[1]))
+            && memCHRs("+-0123456789_", s[1]))
         {
             int exp_digits = 0;
             const char *save_s = s;
diff --git a/util.c b/util.c
index 861633e..0321a6a 100644 (file)
--- a/util.c
+++ b/util.c
@@ -4941,7 +4941,7 @@ Perl_quadmath_format_valid(const char* format)
         return FALSE;
     len = strlen(format);
     /* minimum length three: %Qg */
-    if (len < 3 || strchr("efgaEFGA", format[len - 1]) == NULL)
+    if (len < 3 || memCHRs("efgaEFGA", format[len - 1]) == NULL)
         return FALSE;
     if (format[len - 2] != 'Q')
         return FALSE;
@@ -4998,7 +4998,7 @@ Perl_quadmath_format_needed(const char* format)
       else
         while (isDIGIT(*q)) q++;
     }
-    if (strchr("efgaEFGA", *q)) /* Would have needed 'Q' in front. */
+    if (memCHRs("efgaEFGA", *q)) /* Would have needed 'Q' in front. */
       return TRUE;
     p = q + 1;
   }
diff --git a/util.h b/util.h
index 4b59c7e..6294e59 100644 (file)
--- a/util.h
+++ b/util.h
@@ -17,7 +17,7 @@
        (*(f) == '/'                                                    \
         || (strchr(f,':')                                              \
             || ((*(f) == '[' || *(f) == '<')                           \
-                && (isWORDCHAR((f)[1]) || strchr("$-_]>",(f)[1])))))
+                && (isWORDCHAR((f)[1]) || memCHRs("$-_]>",(f)[1])))))
 
 #elif defined(WIN32) || defined(__CYGWIN__)
 #  define PERL_FILE_IS_ABSOLUTE(f) \
index 050af99..805c916 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -523,7 +523,7 @@ copy_expand_unix_filename_escape(char *outspec, const char *inspec, int *output_
         /* Don't escape again if following character is 
          * already something we escape.
          */
-        if (strchr(".!#&\'`()+@{},;[]%^=_\\", *(inspec+1))) {
+        if (memCHRs(".!#&\'`()+@{},;[]%^=_\\", *(inspec+1))) {
            *outspec = *inspec;
            *output_cnt = 1;
            return 1;
@@ -8799,7 +8799,7 @@ int_tovmsspec(const char *path, char *rslt, int dir_flag, int * utf8_flag)
         /* Don't escape again if following character is 
          * already something we escape.
          */
-        if (strchr("\"`!#%^&()=+\'@[]{}:\\|<>_.", *(cp2+1))) {
+        if (memCHRs("\"`!#%^&()=+\'@[]{}:\\|<>_.", *(cp2+1))) {
            *(cp1++) = *(cp2++);
            break;
         }
@@ -9755,7 +9755,7 @@ vms_image_init(int *argcp, char ***argvp)
       for (cp = av[i]+1; *cp; cp++) {
         if (*cp == 'T') { will_taint = 1; break; }
         else if ( (*cp == 'd' || *cp == 'V') && *(cp+1) == ':' ||
-                  strchr("DFIiMmx",*cp)) break;
+                  memCHRs("DFIiMmx",*cp)) break;
       }
       if (will_taint) break;
     }