@@ -563,7 +563,7 @@ S_missingterm(pTHX_ char *s, const STRLEN len)
563
563
bool uni = FALSE;
564
564
SV * sv ;
565
565
if (s ) {
566
- char * const nl = strrchr ( s , '\n' );
566
+ char * const nl = ( char * ) memrchr ( s , '\n' , len );
567
567
if (nl )
568
568
* nl = '\0' ;
569
569
uni = UTF ;
@@ -585,7 +585,7 @@ S_missingterm(pTHX_ char *s, const STRLEN len)
585
585
}
586
586
s = tmpbuf ;
587
587
}
588
- q = strchr (s ,'"' ) ? '\'' : '"' ;
588
+ q = memrchr (s , '"' , len ) ? '\'' : '"' ;
589
589
sv = sv_2mortal (newSVpv (s ,0 ));
590
590
if (uni )
591
591
SvUTF8_on (sv );
@@ -1767,7 +1767,7 @@ S_incline(pTHX_ const char *s, const char *end)
1767
1767
return ;
1768
1768
while (SPACE_OR_TAB (* s ))
1769
1769
s ++ ;
1770
- if (* s == '"' && (t = strchr ( s + 1 , '"' ))) {
1770
+ if (* s == '"' && (t = ( char * ) memchr ( s + 1 , '"' , end - s ))) {
1771
1771
s ++ ;
1772
1772
e = t + 1 ;
1773
1773
}
@@ -1921,7 +1921,6 @@ STATIC void
1921
1921
S_check_uni (pTHX )
1922
1922
{
1923
1923
const char * s ;
1924
- const char * t ;
1925
1924
1926
1925
if (PL_oldoldbufptr != PL_last_uni )
1927
1926
return ;
@@ -1930,7 +1929,7 @@ S_check_uni(pTHX)
1930
1929
s = PL_last_uni ;
1931
1930
while (isWORDCHAR_lazy_if_safe (s , PL_bufend , UTF ) || * s == '-' )
1932
1931
s += UTF ? UTF8SKIP (s ) : 1 ;
1933
- if (( t = strchr ( s , '(' )) && t < PL_bufptr )
1932
+ if (memchr ( s , '(' , PL_bufptr - s ) )
1934
1933
return ;
1935
1934
1936
1935
Perl_ck_warner_d (aTHX_ packWARN (WARN_AMBIGUOUS ),
@@ -3665,7 +3664,7 @@ S_scan_const(pTHX_ char *start)
3665
3664
s ++ ;
3666
3665
3667
3666
/* If there is no matching '}', it is an error. */
3668
- if (! (e = strchr ( s , '}' ))) {
3667
+ if (! (e = ( char * ) memchr ( s , '}' , send - s ))) {
3669
3668
if (! PL_lex_inpat ) {
3670
3669
yyerror ("Missing right brace on \\N{}" );
3671
3670
} else {
@@ -4179,7 +4178,7 @@ S_intuit_more(pTHX_ char *s, char *e)
4179
4178
/* this is terrifying, and it works */
4180
4179
int weight ;
4181
4180
char seen [256 ];
4182
- const char * const send = strchr ( s , ']' );
4181
+ const char * const send = ( char * ) memchr ( s , ']' , e - s );
4183
4182
unsigned char un_char , last_un_char ;
4184
4183
char tmpbuf [sizeof PL_tokenbuf * 4 ];
4185
4184
@@ -5307,7 +5306,11 @@ Perl_yylex(pTHX)
5307
5306
|| * PL_splitstr == '\''
5308
5307
|| * PL_splitstr == '"' )
5309
5308
&& strchr (PL_splitstr + 1 , * PL_splitstr ))
5309
+ {
5310
+ /* strchr is ok, because -F pattern can't contain
5311
+ * embeddded NULs */
5310
5312
Perl_sv_catpvf (aTHX_ PL_linestr , "our @F=split(%s);" , PL_splitstr );
5313
+ }
5311
5314
else {
5312
5315
/* "q\0${splitstr}\0" is legal perl. Yes, even NUL
5313
5316
bytes can be used as quoting characters. :-) */
@@ -6443,8 +6446,9 @@ Perl_yylex(pTHX)
6443
6446
while (s < d ) {
6444
6447
if (* s ++ == '\n' ) {
6445
6448
incline (s , PL_bufend );
6446
- if (strBEGINs (s ,"=cut" )) {
6447
- s = strchr (s ,'\n' );
6449
+ if (memBEGINs (s , (STRLEN ) (PL_bufend - s ), "=cut" ))
6450
+ {
6451
+ s = (char * ) memchr (s ,'\n' , d - s );
6448
6452
if (s )
6449
6453
s ++ ;
6450
6454
else
@@ -6521,7 +6525,7 @@ Perl_yylex(pTHX)
6521
6525
OPERATOR ('!' );
6522
6526
case '<' :
6523
6527
if (PL_expect != XOPERATOR ) {
6524
- if (s [1 ] != '<' && !strchr (s ,'>' ))
6528
+ if (s [1 ] != '<' && !memchr (s ,'>' , PL_bufend - s ))
6525
6529
check_uni ();
6526
6530
if (s [1 ] == '<' && s [2 ] != '>' ) {
6527
6531
if ( (s == PL_linestart || s [-1 ] == '\n' )
@@ -6699,8 +6703,10 @@ Perl_yylex(pTHX)
6699
6703
else if (* s == '{' ) {
6700
6704
char * t ;
6701
6705
PL_tokenbuf [0 ] = '%' ;
6702
- if (strEQ (PL_tokenbuf + 1 , "SIG" ) && ckWARN (WARN_SYNTAX )
6703
- && (t = strchr (s , '}' )) && (t = strchr (t , '=' )))
6706
+ if ( strEQ (PL_tokenbuf + 1 , "SIG" )
6707
+ && ckWARN (WARN_SYNTAX )
6708
+ && (t = (char * ) memchr (s , '}' , PL_bufend - s ))
6709
+ && (t = (char * ) memchr (t , '=' , PL_bufend - t )))
6704
6710
{
6705
6711
char tmpbuf [sizeof PL_tokenbuf ];
6706
6712
do {
@@ -9957,7 +9963,7 @@ S_scan_heredoc(pTHX_ char *s)
9957
9963
len = d - PL_tokenbuf ;
9958
9964
9959
9965
#ifndef PERL_STRICT_CR
9960
- d = strchr ( s , '\r' );
9966
+ d = ( char * ) memchr ( s , '\r' , PL_bufend - s );
9961
9967
if (d ) {
9962
9968
char * const olds = s ;
9963
9969
s = d ;
@@ -10326,7 +10332,7 @@ S_scan_inputsymbol(pTHX_ char *start)
10326
10332
10327
10333
PERL_ARGS_ASSERT_SCAN_INPUTSYMBOL ;
10328
10334
10329
- end = strchr ( s , '\n' );
10335
+ end = ( char * ) memchr ( s , '\n' , PL_bufend - s );
10330
10336
if (!end )
10331
10337
end = PL_bufend ;
10332
10338
if (s [1 ] == '<' && s [2 ] == '>' && s [3 ] == '>' ) {
0 commit comments