X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/3f7c398ef4badd9c6ec5b40ea29141484c160f63..c0c446747ad6c5bde53bc8415ca16ef77f6320f2:/regexec.c diff --git a/regexec.c b/regexec.c index fae084e..919a12b 100644 --- a/regexec.c +++ b/regexec.c @@ -55,7 +55,6 @@ # define PERL_NO_GET_CONTEXT #endif -/*SUPPRESS 112*/ /* * pregcomp and pregexec -- regsub and regerror are not used in perl * @@ -79,7 +78,7 @@ **** Alterations to Henry's code are... **** **** Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - **** 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others + **** 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others **** **** You may distribute under the terms of either the GNU General Public **** License or the Artistic License, as specified in the README file. @@ -140,7 +139,12 @@ #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim)) #define HOPMAYBE3c(pos,off,lim) ((char*)HOPMAYBE3(pos,off,lim)) -#define LOAD_UTF8_CHARCLASS(a,b) STMT_START { if (!CAT2(PL_utf8_,a)) { ENTER; save_re_context(); (void)CAT2(is_utf8_, a)((const U8*)b); LEAVE; } } STMT_END +#define LOAD_UTF8_CHARCLASS(class,str) STMT_START { \ + if (!CAT2(PL_utf8_,class)) { bool ok; ENTER; save_re_context(); ok=CAT2(is_utf8_,class)((const U8*)str); assert(ok); LEAVE; } } STMT_END +#define LOAD_UTF8_CHARCLASS_ALNUM() LOAD_UTF8_CHARCLASS(alnum,"a") +#define LOAD_UTF8_CHARCLASS_DIGIT() LOAD_UTF8_CHARCLASS(digit,"0") +#define LOAD_UTF8_CHARCLASS_SPACE() LOAD_UTF8_CHARCLASS(space," ") +#define LOAD_UTF8_CHARCLASS_MARK() LOAD_UTF8_CHARCLASS(mark, "\xcd\x86") /* for use after a quantifier and before an EXACT-like node -- japhy */ #define JUMPABLE(rn) ( \ @@ -174,6 +178,7 @@ static void restore_pos(pTHX_ void *arg); STATIC CHECKPOINT S_regcppush(pTHX_ I32 parenfloor) { + dVAR; const int retval = PL_savestack_ix; #define REGCP_PAREN_ELEMS 4 const int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS; @@ -218,6 +223,7 @@ S_regcppush(pTHX_ I32 parenfloor) STATIC char * S_regcppop(pTHX) { + dVAR; I32 i; U32 paren = 0; char *input; @@ -279,17 +285,6 @@ S_regcppop(pTHX) return input; } -STATIC char * -S_regcp_set_to(pTHX_ I32 ss) -{ - const I32 tmp = PL_savestack_ix; - - PL_savestack_ix = ss; - regcppop(); - PL_savestack_ix = tmp; - return Nullch; -} - typedef struct re_cc_state { I32 ss; @@ -340,6 +335,7 @@ Perl_pregexec(pTHX_ register regexp *prog, char *stringarg, register char *stren STATIC void S_cache_re(pTHX_ regexp *prog) { + dVAR; PL_regprecomp = prog->precomp; /* Needed for FAIL. */ #ifdef DEBUGGING PL_regprogram = prog->program; @@ -399,6 +395,7 @@ char * Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, char *strend, U32 flags, re_scream_pos_data *data) { + dVAR; register I32 start_shift = 0; /* Should be nonnegative! */ register I32 end_shift = 0; @@ -408,12 +405,12 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, char *t; const int do_utf8 = sv ? SvUTF8(sv) : 0; /* if no sv we have to assume bytes */ I32 ml_anch; - register char *other_last = Nullch; /* other substr checked before this */ - char *check_at = Nullch; /* check substr found at this pos */ + register char *other_last = NULL; /* other substr checked before this */ + char *check_at = NULL; /* check substr found at this pos */ const I32 multiline = prog->reganch & PMf_MULTILINE; #ifdef DEBUGGING - char *i_strpos = strpos; - SV *dsv = PERL_DEBUG_PAD_ZERO(0); + const char * const i_strpos = strpos; + SV * const dsv = PERL_DEBUG_PAD_ZERO(0); #endif GET_RE_DEBUG_FLAGS_DECL; @@ -514,6 +511,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, || ((slen = SvCUR(check)) > 1 && memNE(SvPVX_const(check), s, slen))) goto report_neq; + check_at = s; goto success_at_start; } } @@ -611,7 +609,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, if (check == (do_utf8 ? prog->float_utf8 : prog->float_substr)) { do_other_anchored: { - char *last = HOP3c(s, -start_shift, strbeg), *last1, *last2; + char * const last = HOP3c(s, -start_shift, strbeg); + char *last1, *last2; char *s1 = s; SV* must; @@ -833,9 +832,9 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, SvREFCNT_dec(do_utf8 ? prog->check_utf8 : prog->check_substr); if (do_utf8 ? prog->check_substr : prog->check_utf8) SvREFCNT_dec(do_utf8 ? prog->check_substr : prog->check_utf8); - prog->check_substr = prog->check_utf8 = Nullsv; /* disable */ - prog->float_substr = prog->float_utf8 = Nullsv; /* clear */ - check = Nullsv; /* abort */ + prog->check_substr = prog->check_utf8 = NULL; /* disable */ + prog->float_substr = prog->float_utf8 = NULL; /* clear */ + check = NULL; /* abort */ s = strpos; /* XXXX This is a remnant of the old implementation. It looks wasteful, since now INTUIT can use many @@ -857,7 +856,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, regstclass does not come from lookahead... */ /* If regstclass takes bytelength more than 1: If charlength==1, OK. This leaves EXACTF only, which is dealt with in find_byclass(). */ - const U8* str = (U8*)STRING(prog->regstclass); + const U8* const str = (U8*)STRING(prog->regstclass); const int cl_l = (PL_regkind[(U8)OP(prog->regstclass)] == EXACT ? CHR_DIST(str+STR_LEN(prog->regstclass), str) : 1); @@ -873,7 +872,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, s = find_byclass(prog, prog->regstclass, s, endpos, 1); if (!s) { #ifdef DEBUGGING - const char *what = 0; + const char *what = NULL; #endif if (endpos == strend) { DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, @@ -958,7 +957,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, fail: DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n", PL_colors[4], PL_colors[5])); - return Nullch; + return NULL; } /* We know what class REx starts with. Try to find this position... */ @@ -1034,14 +1033,15 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 U8 *sm = (U8 *) m; U8 tmpbuf1[UTF8_MAXBYTES_CASE+1]; U8 tmpbuf2[UTF8_MAXBYTES_CASE+1]; + const U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY; to_utf8_lower((U8*)m, tmpbuf1, &ulen1); to_utf8_upper((U8*)m, tmpbuf2, &ulen2); c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXBYTES_CASE, - 0, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY); + 0, uniflags); c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXBYTES_CASE, - 0, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY); + 0, uniflags); lnc = 0; while (sm < ((U8 *) m + ln)) { lnc++; @@ -1080,14 +1080,13 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 UV c, f; U8 tmpbuf [UTF8_MAXBYTES+1]; STRLEN len, foldlen; - + const U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY; if (c1 == c2) { /* Upper and lower of 1st char are equal - * probably not a "letter". */ while (s <= e) { c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len, - ckWARN(WARN_UTF8) ? - 0 : UTF8_ALLOW_ANY); + uniflags); if ( c == c1 && (ln == len || ibcmp_utf8(s, (char **)0, 0, do_utf8, @@ -1114,8 +1113,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 else { while (s <= e) { c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len, - ckWARN(WARN_UTF8) ? - 0 : UTF8_ALLOW_ANY); + uniflags); /* Handle some of the three Greek sigmas cases. * Note that not all the possible combinations @@ -1183,13 +1181,12 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 if (s == PL_bostr) tmp = '\n'; else { - U8 *r = reghop3((U8*)s, -1, (U8*)PL_bostr); - + U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr); tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, 0); } tmp = ((OP(c) == BOUND ? isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0); - LOAD_UTF8_CHARCLASS(alnum,"a"); + LOAD_UTF8_CHARCLASS_ALNUM(); while (s + (uskip = UTF8SKIP(s)) <= strend) { if (tmp == !(OP(c) == BOUND ? swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) : @@ -1226,13 +1223,12 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 if (s == PL_bostr) tmp = '\n'; else { - U8 *r = reghop3((U8*)s, -1, (U8*)PL_bostr); - + U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr); tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, 0); } tmp = ((OP(c) == NBOUND ? isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0); - LOAD_UTF8_CHARCLASS(alnum,"a"); + LOAD_UTF8_CHARCLASS_ALNUM(); while (s + (uskip = UTF8SKIP(s)) <= strend) { if (tmp == !(OP(c) == NBOUND ? swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) : @@ -1261,7 +1257,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 break; case ALNUM: if (do_utf8) { - LOAD_UTF8_CHARCLASS(alnum,"a"); + LOAD_UTF8_CHARCLASS_ALNUM(); while (s + (uskip = UTF8SKIP(s)) <= strend) { if (swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) { if (tmp && (norun || regtry(prog, s))) @@ -1319,7 +1315,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 break; case NALNUM: if (do_utf8) { - LOAD_UTF8_CHARCLASS(alnum,"a"); + LOAD_UTF8_CHARCLASS_ALNUM(); while (s + (uskip = UTF8SKIP(s)) <= strend) { if (!swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) { if (tmp && (norun || regtry(prog, s))) @@ -1377,7 +1373,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 break; case SPACE: if (do_utf8) { - LOAD_UTF8_CHARCLASS(space," "); + LOAD_UTF8_CHARCLASS_SPACE(); while (s + (uskip = UTF8SKIP(s)) <= strend) { if (*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8)) { if (tmp && (norun || regtry(prog, s))) @@ -1435,7 +1431,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 break; case NSPACE: if (do_utf8) { - LOAD_UTF8_CHARCLASS(space," "); + LOAD_UTF8_CHARCLASS_SPACE(); while (s + (uskip = UTF8SKIP(s)) <= strend) { if (!(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8))) { if (tmp && (norun || regtry(prog, s))) @@ -1493,7 +1489,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 break; case DIGIT: if (do_utf8) { - LOAD_UTF8_CHARCLASS(digit,"0"); + LOAD_UTF8_CHARCLASS_DIGIT(); while (s + (uskip = UTF8SKIP(s)) <= strend) { if (swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) { if (tmp && (norun || regtry(prog, s))) @@ -1551,7 +1547,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 break; case NDIGIT: if (do_utf8) { - LOAD_UTF8_CHARCLASS(digit,"0"); + LOAD_UTF8_CHARCLASS_DIGIT(); while (s + (uskip = UTF8SKIP(s)) <= strend) { if (!swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) { if (tmp && (norun || regtry(prog, s))) @@ -1628,6 +1624,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * /* data: May be used for some additional optimizations. */ /* nosave: For optimizations. */ { + dVAR; register char *s; register regnode *c; register char *startpos = stringarg; @@ -1640,13 +1637,13 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * const bool do_utf8 = DO_UTF8(sv); const I32 multiline = prog->reganch & PMf_MULTILINE; #ifdef DEBUGGING - SV *dsv0 = PERL_DEBUG_PAD_ZERO(0); - SV *dsv1 = PERL_DEBUG_PAD_ZERO(1); + SV * const dsv0 = PERL_DEBUG_PAD_ZERO(0); + SV * const dsv1 = PERL_DEBUG_PAD_ZERO(1); #endif GET_RE_DEBUG_FLAGS_DECL; - (void)data; /* Currently unused */ + PERL_UNUSED_ARG(data); RX_MATCH_UTF8_set(prog,do_utf8); PL_regcc = 0; @@ -1718,7 +1715,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * PL_reg_ganch = strbeg; } - if (!(flags & REXEC_CHECKED) && (prog->check_substr != Nullsv || prog->check_utf8 != Nullsv)) { + if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) { re_scream_pos_data d; d.scream_olds = &scream_olds; @@ -1844,10 +1841,9 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * "Did not find anchored character...\n") ); } - /*SUPPRESS 560*/ - else if (prog->anchored_substr != Nullsv - || prog->anchored_utf8 != Nullsv - || ((prog->float_substr != Nullsv || prog->float_utf8 != Nullsv) + else if (prog->anchored_substr != NULL + || prog->anchored_utf8 != NULL + || ((prog->float_substr != NULL || prog->float_utf8 != NULL) && prog->float_max_offset < strend - s)) { SV *must; I32 back_max; @@ -1944,8 +1940,8 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * } DEBUG_EXECUTE_r({ SV *prop = sv_newmortal(); - char *s0; - char *s1; + const char *s0; + const char *s1; int len0; int len1; @@ -1953,7 +1949,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * s0 = UTF ? pv_uni_display(dsv0, (U8*)SvPVX_const(prop), SvCUR(prop), 60, UNI_DISPLAY_REGEX) : - SvPVX(prop); + SvPVX_const(prop); len0 = UTF ? SvCUR(dsv0) : SvCUR(prop); s1 = UTF ? sv_uni_display(dsv1, sv, 60, UNI_DISPLAY_REGEX) : s; @@ -1969,7 +1965,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * } else { dontbother = 0; - if (prog->float_substr != Nullsv || prog->float_utf8 != Nullsv) { + if (prog->float_substr != NULL || prog->float_utf8 != NULL) { /* Trim the end. */ char *last; SV* float_real; @@ -1989,14 +1985,14 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * } else { STRLEN len; - const char * const little = SvPV(float_real, len); + const char * const little = SvPV_const(float_real, len); if (SvTAIL(float_real)) { if (memEQ(strend - len + 1, little, len - 1)) last = strend - len + 1; else if (!multiline) last = memEQ(strend - len, little, len) - ? strend - len : Nullch; + ? strend - len : NULL; else goto find_last; } else { @@ -2056,7 +2052,7 @@ got_it: RX_MATCH_COPY_FREE(prog); if (flags & REXEC_COPY_STR) { I32 i = PL_regeol - startpos + (stringarg - strbeg); -#ifdef PERL_COPY_ON_WRITE +#ifdef PERL_OLD_COPY_ON_WRITE if ((SvIsCOW(sv) || (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS)) { if (DEBUG_C_TEST) { @@ -2065,7 +2061,7 @@ got_it: (int) SvTYPE(sv)); } prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv); - prog->subbeg = SvPVX(prog->saved_copy); + prog->subbeg = (char *)SvPVX_const(prog->saved_copy); assert (SvPOKp(prog->saved_copy)); } else #endif @@ -2098,6 +2094,7 @@ phooey: STATIC I32 /* 0 failure, 1 success */ S_regtry(pTHX_ regexp *prog, char *startpos) { + dVAR; register I32 i; register I32 *sp; register I32 *ep; @@ -2134,7 +2131,7 @@ S_regtry(pTHX_ regexp *prog, char *startpos) && (mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global)))) { /* prepare for quick setting of pos */ sv_magic(PL_reg_sv, (SV*)0, - PERL_MAGIC_regex_global, Nullch, 0); + PERL_MAGIC_regex_global, NULL, 0); mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global); mg->mg_len = -1; } @@ -2143,7 +2140,7 @@ S_regtry(pTHX_ regexp *prog, char *startpos) SAVEDESTRUCTOR_X(restore_pos, 0); } if (!PL_reg_curpm) { - Newz(22, PL_reg_curpm, 1, PMOP); + Newxz(PL_reg_curpm, 1, PMOP); #ifdef USE_ITHREADS { SV* repointer = newSViv(0); @@ -2164,13 +2161,13 @@ S_regtry(pTHX_ regexp *prog, char *startpos) $` inside (?{}) could fail... */ PL_reg_oldsaved = prog->subbeg; PL_reg_oldsavedlen = prog->sublen; -#ifdef PERL_COPY_ON_WRITE +#ifdef PERL_OLD_COPY_ON_WRITE PL_nrs = prog->saved_copy; #endif RX_MATCH_COPIED_off(prog); } else - PL_reg_oldsaved = Nullch; + PL_reg_oldsaved = NULL; prog->subbeg = PL_bostr; prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */ } @@ -2189,7 +2186,7 @@ S_regtry(pTHX_ regexp *prog, char *startpos) if(PL_reg_start_tmp) Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*); else - New(22, PL_reg_start_tmp, PL_reg_start_tmpl, char*); + Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*); } /* XXXX What this code is doing here?!!! There should be no need @@ -2318,8 +2315,7 @@ typedef union re_unwind_t { ENTER; \ SAVETMPS; \ bufflen = TRIE_INITAL_ACCEPT_BUFFLEN ; \ - sv_accept_buff=NEWSV( 1234, \ - bufflen * sizeof(reg_trie_accepted) - 1 ); \ + sv_accept_buff=newSV(bufflen * sizeof(reg_trie_accepted) - 1 );\ SvCUR_set( sv_accept_buff, sizeof(reg_trie_accepted) ); \ SvPOK_on( sv_accept_buff ); \ sv_2mortal( sv_accept_buff ); \ @@ -2389,29 +2385,30 @@ S_regmatch(pTHX_ regnode *prog) function of same name */ register I32 n; /* no or next */ register I32 ln = 0; /* len or last */ - register char *s = Nullch; /* operand or save */ + register char *s = NULL; /* operand or save */ register char *locinput = PL_reginput; register I32 c1 = 0, c2 = 0, paren; /* case fold search, parenth */ int minmod = 0, sw = 0, logical = 0; I32 unwind = 0; /* used by the trie code */ - SV *sv_accept_buff = 0; /* accepting states we have traversed */ - reg_trie_accepted *accept_buff = 0; /* "" */ + SV *sv_accept_buff = NULL; /* accepting states we have traversed */ + reg_trie_accepted *accept_buff = NULL; /* "" */ reg_trie_data *trie; /* what trie are we using right now */ U32 accepted = 0; /* how many accepting states we have seen*/ #if 0 I32 firstcp = PL_savestack_ix; #endif - const register bool do_utf8 = PL_reg_match_utf8; + register const bool do_utf8 = PL_reg_match_utf8; #ifdef DEBUGGING - SV *dsv0 = PERL_DEBUG_PAD_ZERO(0); - SV *dsv1 = PERL_DEBUG_PAD_ZERO(1); - SV *dsv2 = PERL_DEBUG_PAD_ZERO(2); + SV * const dsv0 = PERL_DEBUG_PAD_ZERO(0); + SV * const dsv1 = PERL_DEBUG_PAD_ZERO(1); + SV * const dsv2 = PERL_DEBUG_PAD_ZERO(2); SV *re_debug_flags = NULL; #endif + U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY; GET_RE_DEBUG_FLAGS; @@ -2426,7 +2423,7 @@ S_regmatch(pTHX_ regnode *prog) while (scan != NULL) { DEBUG_EXECUTE_r( { - SV *prop = sv_newmortal(); + SV * const prop = sv_newmortal(); const int docolor = *PL_colors[0]; const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */ int l = (PL_regeol - locinput) > taill ? taill : (PL_regeol - locinput); @@ -2579,8 +2576,6 @@ S_regmatch(pTHX_ regnode *prog) case TRIEF: case TRIEFL: { - - const U32 uniflags = ckWARN( WARN_UTF8 ) ? 0 : UTF8_ALLOW_ANY; U8 *uc = ( U8* )locinput; U32 state = 1; U16 charid = 0; @@ -2609,7 +2604,7 @@ S_regmatch(pTHX_ regnode *prog) if ( base ) { - if ( do_utf8 || UTF ) { + if ( do_utf8 ) { if ( foldlen>0 ) { uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags ); foldlen -= len; @@ -2648,7 +2643,6 @@ S_regmatch(pTHX_ regnode *prog) from previous if blocks */ case TRIE: { - const U32 uniflags = ckWARN( WARN_UTF8 ) ? 0 : UTF8_ALLOW_ANY; U8 *uc = (U8*)locinput; U32 state = 1; U16 charid = 0; @@ -2675,7 +2669,7 @@ S_regmatch(pTHX_ regnode *prog) if ( base ) { - if ( do_utf8 || UTF ) { + if ( do_utf8 ) { uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags ); } else { uvc = (U32)*uc; @@ -2722,7 +2716,7 @@ S_regmatch(pTHX_ regnode *prog) "%*s %sonly one match : #%d <%s>%s\n", REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], accept_buff[ 0 ].wordnum, - tmp ? SvPV_nolen( *tmp ) : "not compiled under -Dr", + tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr", PL_colors[5] ); }); PL_reginput = (char *)accept_buff[ 0 ].endpos; @@ -2753,11 +2747,11 @@ S_regmatch(pTHX_ regnode *prog) best = cur; } DEBUG_EXECUTE_r({ - SV **tmp = av_fetch( trie->words, accept_buff[ best ].wordnum - 1, 0 ); + SV ** const tmp = av_fetch( trie->words, accept_buff[ best ].wordnum - 1, 0 ); PerlIO_printf( Perl_debug_log, "%*s %strying alternation #%d <%s> at 0x%p%s\n", REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], accept_buff[best].wordnum, - tmp ? SvPV_nolen( *tmp ) : "not compiled under -Dr",scan, + tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",scan, PL_colors[5] ); }); if ( best= PL_regeol) sayNO; if (do_utf8) { - LOAD_UTF8_CHARCLASS(alnum,"a"); + LOAD_UTF8_CHARCLASS_ALNUM(); if (OP(scan) == NALNUM ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8) : isALNUM_LC_utf8((U8*)locinput)) @@ -2985,7 +2977,7 @@ S_regmatch(pTHX_ regnode *prog) } if (OP(scan) == BOUND || OP(scan) == NBOUND) { ln = isALNUM_uni(ln); - LOAD_UTF8_CHARCLASS(alnum,"a"); + LOAD_UTF8_CHARCLASS_ALNUM(); n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8); } else { @@ -3017,7 +3009,7 @@ S_regmatch(pTHX_ regnode *prog) sayNO; if (do_utf8) { if (UTF8_IS_CONTINUED(nextchr)) { - LOAD_UTF8_CHARCLASS(space," "); + LOAD_UTF8_CHARCLASS_SPACE(); if (!(OP(scan) == SPACE ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8) : isSPACE_LC_utf8((U8*)locinput))) @@ -3047,7 +3039,7 @@ S_regmatch(pTHX_ regnode *prog) if (!nextchr && locinput >= PL_regeol) sayNO; if (do_utf8) { - LOAD_UTF8_CHARCLASS(space," "); + LOAD_UTF8_CHARCLASS_SPACE(); if (OP(scan) == NSPACE ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8) : isSPACE_LC_utf8((U8*)locinput)) @@ -3070,7 +3062,7 @@ S_regmatch(pTHX_ regnode *prog) if (!nextchr) sayNO; if (do_utf8) { - LOAD_UTF8_CHARCLASS(digit,"0"); + LOAD_UTF8_CHARCLASS_DIGIT(); if (!(OP(scan) == DIGIT ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8) : isDIGIT_LC_utf8((U8*)locinput))) @@ -3093,7 +3085,7 @@ S_regmatch(pTHX_ regnode *prog) if (!nextchr && locinput >= PL_regeol) sayNO; if (do_utf8) { - LOAD_UTF8_CHARCLASS(digit,"0"); + LOAD_UTF8_CHARCLASS_DIGIT(); if (OP(scan) == NDIGIT ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8) : isDIGIT_LC_utf8((U8*)locinput)) @@ -3113,7 +3105,7 @@ S_regmatch(pTHX_ regnode *prog) if (locinput >= PL_regeol) sayNO; if (do_utf8) { - LOAD_UTF8_CHARCLASS(mark,"~"); + LOAD_UTF8_CHARCLASS_MARK(); if (swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8)) sayNO; locinput += PL_utf8skip[nextchr]; @@ -3197,11 +3189,11 @@ S_regmatch(pTHX_ regnode *prog) case EVAL: { dSP; - OP_4tree *oop = PL_op; - COP *ocurcop = PL_curcop; + OP_4tree * const oop = PL_op; + COP * const ocurcop = PL_curcop; PAD *old_comppad; SV *ret; - struct regexp *oreg = PL_reg_re; + struct regexp * const oreg = PL_reg_re; n = ARG(scan); PL_op = (OP_4tree*)PL_regdata->data[n]; @@ -3210,7 +3202,7 @@ S_regmatch(pTHX_ regnode *prog) PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr; { - SV **before = SP; + SV ** const before = SP; CALLRUNOPS(aTHX); /* Scalar context. */ SPAGAIN; if (SP == before) @@ -3227,7 +3219,7 @@ S_regmatch(pTHX_ regnode *prog) if (logical) { if (logical == 2) { /* Postponed subexpression. */ regexp *re; - MAGIC *mg = Null(MAGIC*); + MAGIC *mg = NULL; re_cc_state state; CHECKPOINT cp, lastcp; int toggleutf; @@ -3248,7 +3240,7 @@ S_regmatch(pTHX_ regnode *prog) } else { STRLEN len; - char *t = SvPV(ret, len); + const char * const t = SvPV_const(ret, len); PMOP pm; char * const oprecomp = PL_regprecomp; const I32 osize = PL_regsize; @@ -3256,7 +3248,7 @@ S_regmatch(pTHX_ regnode *prog) Zero(&pm, 1, PMOP); if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8; - re = CALLREGCOMP(aTHX_ t, t + len, &pm); + re = CALLREGCOMP(aTHX_ (char*)t, (char*)t + len, &pm); if (!(SvFLAGS(ret) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY | SVs_GMG))) @@ -3474,7 +3466,7 @@ S_regmatch(pTHX_ regnode *prog) PL_regcc = cc.oldcc; saySAME(n); } - /* NOT REACHED */ + /* NOTREACHED */ case WHILEM: { /* * This is really hard to understand, because after we match @@ -3487,7 +3479,7 @@ S_regmatch(pTHX_ regnode *prog) CHECKPOINT cp, lastcp; CURCUR* cc = PL_regcc; - char *lastloc = cc->lastloc; /* Detection of 0-len. */ + char * const lastloc = cc->lastloc; /* Detection of 0-len. */ I32 cache_offset = 0, cache_bit = 0; n = cc->cur + 1; /* how many we know we matched */ @@ -3551,7 +3543,7 @@ S_regmatch(pTHX_ regnode *prog) } else { PL_reg_poscache_size = size; - Newz(29, PL_reg_poscache, size, char); + Newxz(PL_reg_poscache, size, char); } DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, @@ -3675,7 +3667,7 @@ S_regmatch(pTHX_ regnode *prog) cc->lastloc = lastloc; CACHEsayNO; } - /* NOT REACHED */ + /* NOTREACHED */ case BRANCHJ: next = scan + ARG(scan); if (next == scan) @@ -3691,12 +3683,10 @@ S_regmatch(pTHX_ regnode *prog) next = inner; /* Avoid recursion. */ else { const I32 lastparen = *PL_reglastparen; - I32 unwind1; - re_unwind_branch_t *uw; - /* Put unwinding data on stack */ - unwind1 = SSNEWt(1,re_unwind_branch_t); - uw = SSPTRt(unwind1,re_unwind_branch_t); + const I32 unwind1 = SSNEWt(1,re_unwind_branch_t); + re_unwind_branch_t * const uw = SSPTRt(unwind1,re_unwind_branch_t); + uw->prev = unwind; unwind = unwind1; uw->type = ((c1 == BRANCH) @@ -3865,6 +3855,7 @@ S_regmatch(pTHX_ regnode *prog) } } sayNO; + /* NOTREACHED */ break; } case CURLYN: @@ -3937,16 +3928,13 @@ S_regmatch(pTHX_ regnode *prog) to_utf8_upper((U8*)s, tmpbuf2, &ulen2); c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0, - ckWARN(WARN_UTF8) ? - 0 : UTF8_ALLOW_ANY); + uniflags); c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0, - ckWARN(WARN_UTF8) ? - 0 : UTF8_ALLOW_ANY); + uniflags); } else { c2 = c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0, - ckWARN(WARN_UTF8) ? - 0 : UTF8_ALLOW_ANY); + uniflags); } } } @@ -4007,8 +3995,7 @@ S_regmatch(pTHX_ regnode *prog) while (locinput <= e && utf8n_to_uvchr((U8*)locinput, UTF8_MAXBYTES, &len, - ckWARN(WARN_UTF8) ? - 0 : UTF8_ALLOW_ANY) != (UV)c1) { + uniflags) != (UV)c1) { locinput += len; count++; } @@ -4019,8 +4006,7 @@ S_regmatch(pTHX_ regnode *prog) while (locinput <= e) { UV c = utf8n_to_uvchr((U8*)locinput, UTF8_MAXBYTES, &len, - ckWARN(WARN_UTF8) ? - 0 : UTF8_ALLOW_ANY); + uniflags); if (c == (UV)c1 || c == (UV)c2) break; locinput += len; @@ -4056,8 +4042,7 @@ S_regmatch(pTHX_ regnode *prog) if (do_utf8) c = utf8n_to_uvchr((U8*)PL_reginput, UTF8_MAXBYTES, 0, - ckWARN(WARN_UTF8) ? - 0 : UTF8_ALLOW_ANY); + uniflags); else c = UCHARAT(PL_reginput); /* If it could work, try it. */ @@ -4106,8 +4091,7 @@ S_regmatch(pTHX_ regnode *prog) if (do_utf8) c = utf8n_to_uvchr((U8*)PL_reginput, UTF8_MAXBYTES, 0, - ckWARN(WARN_UTF8) ? - 0 : UTF8_ALLOW_ANY); + uniflags); else c = UCHARAT(PL_reginput); } @@ -4129,8 +4113,7 @@ S_regmatch(pTHX_ regnode *prog) if (do_utf8) c = utf8n_to_uvchr((U8*)PL_reginput, UTF8_MAXBYTES, 0, - ckWARN(WARN_UTF8) ? - 0 : UTF8_ALLOW_ANY); + uniflags); else c = UCHARAT(PL_reginput); } @@ -4153,14 +4136,22 @@ S_regmatch(pTHX_ regnode *prog) re_cc_state *cur_call_cc = PL_reg_call_cc; CURCUR *cctmp = PL_regcc; regexp *re = PL_reg_re; - CHECKPOINT cp, lastcp; - - cp = regcppush(0); /* Save *all* the positions. */ + CHECKPOINT lastcp; + I32 tmp; + + /* Save *all* the positions. */ + const CHECKPOINT cp = regcppush(0); REGCP_SET(lastcp); - regcp_set_to(PL_reg_call_cc->ss); /* Restore parens of - the caller. */ - PL_reginput = locinput; /* Make position available to - the callcc. */ + + /* Restore parens of the caller. */ + tmp = PL_savestack_ix; + PL_savestack_ix = PL_reg_call_cc->ss; + regcppop(); + PL_savestack_ix = tmp; + + /* Make position available to the callcc. */ + PL_reginput = locinput; + cache_re(PL_reg_call_cc->re); PL_regcc = PL_reg_call_cc->cc; PL_reg_call_cc = PL_reg_call_cc->prev; @@ -4299,13 +4290,13 @@ no: no_final: do_no: if (unwind) { - re_unwind_t *uw = SSPTRt(unwind,re_unwind_t); + re_unwind_t * const uw = SSPTRt(unwind,re_unwind_t); switch (uw->type) { case RE_UNWIND_BRANCH: case RE_UNWIND_BRANCHJ: { - re_unwind_branch_t *uwb = &(uw->branch); + re_unwind_branch_t * const uwb = &(uw->branch); const I32 lastparen = uwb->lastparen; REGCP_UNWIND(uwb->lastcp); @@ -4323,7 +4314,6 @@ do_no: goto do_no; } /* Have more choice yet. Reuse the same uwb. */ - /*SUPPRESS 560*/ if ((n = (uwb->type == RE_UNWIND_BRANCH ? NEXT_OFF(next) : ARG(next)))) next += n; @@ -4341,11 +4331,11 @@ do_no: goto reenter; } - /* NOT REACHED */ + /* NOTREACHED */ default: Perl_croak(aTHX_ "regexp unwind memory corruption"); } - /* NOT REACHED */ + /* NOTREACHED */ } #ifdef DEBUGGING PL_regindent--; @@ -4437,7 +4427,7 @@ S_regrepeat(pTHX_ const regnode *p, I32 max) case ALNUM: if (do_utf8) { loceol = PL_regeol; - LOAD_UTF8_CHARCLASS(alnum,"a"); + LOAD_UTF8_CHARCLASS_ALNUM(); while (hardcount < max && scan < loceol && swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) { scan += UTF8SKIP(scan); @@ -4465,7 +4455,7 @@ S_regrepeat(pTHX_ const regnode *p, I32 max) case NALNUM: if (do_utf8) { loceol = PL_regeol; - LOAD_UTF8_CHARCLASS(alnum,"a"); + LOAD_UTF8_CHARCLASS_ALNUM(); while (hardcount < max && scan < loceol && !swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) { scan += UTF8SKIP(scan); @@ -4493,7 +4483,7 @@ S_regrepeat(pTHX_ const regnode *p, I32 max) case SPACE: if (do_utf8) { loceol = PL_regeol; - LOAD_UTF8_CHARCLASS(space," "); + LOAD_UTF8_CHARCLASS_SPACE(); while (hardcount < max && scan < loceol && (*scan == ' ' || swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) { @@ -4522,7 +4512,7 @@ S_regrepeat(pTHX_ const regnode *p, I32 max) case NSPACE: if (do_utf8) { loceol = PL_regeol; - LOAD_UTF8_CHARCLASS(space," "); + LOAD_UTF8_CHARCLASS_SPACE(); while (hardcount < max && scan < loceol && !(*scan == ' ' || swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) { @@ -4551,7 +4541,7 @@ S_regrepeat(pTHX_ const regnode *p, I32 max) case DIGIT: if (do_utf8) { loceol = PL_regeol; - LOAD_UTF8_CHARCLASS(digit,"0"); + LOAD_UTF8_CHARCLASS_DIGIT(); while (hardcount < max && scan < loceol && swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) { scan += UTF8SKIP(scan); @@ -4565,7 +4555,7 @@ S_regrepeat(pTHX_ const regnode *p, I32 max) case NDIGIT: if (do_utf8) { loceol = PL_regeol; - LOAD_UTF8_CHARCLASS(digit,"0"); + LOAD_UTF8_CHARCLASS_DIGIT(); while (hardcount < max && scan < loceol && !swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) { scan += UTF8SKIP(scan); @@ -4588,7 +4578,7 @@ S_regrepeat(pTHX_ const regnode *p, I32 max) DEBUG_r({ SV *re_debug_flags = NULL; - SV *prop = sv_newmortal(); + SV * const prop = sv_newmortal(); GET_RE_DEBUG_FLAGS; DEBUG_EXECUTE_r({ regprop(prop, p); @@ -4610,7 +4600,8 @@ S_regrepeat(pTHX_ const regnode *p, I32 max) STATIC I32 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp) { - register char *scan = Nullch; + dVAR; + register char *scan = NULL; register char *start; register char *loceol = PL_regeol; I32 l = 0; @@ -4660,6 +4651,7 @@ S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp) SV * Perl_regclass_swash(pTHX_ register const regnode* node, bool doinit, SV** listsvp, SV **altsvp) { + dVAR; SV *sw = NULL; SV *si = NULL; SV *alt = NULL; @@ -4668,16 +4660,16 @@ Perl_regclass_swash(pTHX_ register const regnode* node, bool doinit, SV** listsv const U32 n = ARG(node); if (PL_regdata->what[n] == 's') { - SV *rv = (SV*)PL_regdata->data[n]; - AV *av = (AV*)SvRV((SV*)rv); - SV **ary = AvARRAY(av); + SV * const rv = (SV*)PL_regdata->data[n]; + AV * const av = (AV*)SvRV((SV*)rv); + SV **const ary = AvARRAY(av); SV **a, **b; - /* See the end of regcomp.c:S_reglass() for + /* See the end of regcomp.c:S_regclass() for * documentation of these array elements. */ si = *ary; - a = SvTYPE(ary[1]) == SVt_RV ? &ary[1] : 0; + a = SvROK(ary[1]) ? &ary[1] : 0; b = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : 0; if (a) @@ -4719,9 +4711,13 @@ S_reginclass(pTHX_ register const regnode *n, register const U8* p, STRLEN* lenp STRLEN len = 0; STRLEN plen; - if (do_utf8 && !UTF8_IS_INVARIANT(c)) - c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &len, - ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY); + if (do_utf8 && !UTF8_IS_INVARIANT(c)) { + c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &len, + ckWARN(WARN_UTF8) ? UTF8_CHECK_ONLY : + UTF8_ALLOW_ANYUV|UTF8_CHECK_ONLY); + if (len == (STRLEN)-1) + Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)"); + } plen = lenp ? *lenp : UNISKIP(NATIVE_TO_UNI(c)); if (do_utf8 || (flags & ANYOF_UNICODE)) { @@ -4735,7 +4731,7 @@ S_reginclass(pTHX_ register const regnode *n, register const U8* p, STRLEN* lenp match = TRUE; if (!match) { AV *av; - SV *sw = regclass_swash(n, TRUE, 0, (SV**)&av); + SV * const sw = regclass_swash(n, TRUE, 0, (SV**)&av); if (sw) { if (swash_fetch(sw, p, do_utf8)) @@ -4743,11 +4739,10 @@ S_reginclass(pTHX_ register const regnode *n, register const U8* p, STRLEN* lenp else if (flags & ANYOF_FOLD) { if (!match && lenp && av) { I32 i; - for (i = 0; i <= av_len(av); i++) { - SV* sv = *av_fetch(av, i, FALSE); + SV* const sv = *av_fetch(av, i, FALSE); STRLEN len; - const char *s = SvPV(sv, len); + const char * const s = SvPV_const(sv, len); if (len <= plen && memEQ(s, (char*)p, len)) { *lenp = len; @@ -4832,12 +4827,14 @@ S_reginclass(pTHX_ register const regnode *n, register const U8* p, STRLEN* lenp STATIC U8 * S_reghop(pTHX_ U8 *s, I32 off) { - return S_reghop3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr)); + dVAR; + return S_reghop3(s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr)); } STATIC U8 * -S_reghop3(pTHX_ U8 *s, I32 off, U8* lim) +S_reghop3(U8 *s, I32 off, U8* lim) { + dVAR; if (off >= 0) { while (off-- && s < lim) { /* XXX could check well-formedness here */ @@ -4862,12 +4859,14 @@ S_reghop3(pTHX_ U8 *s, I32 off, U8* lim) STATIC U8 * S_reghopmaybe(pTHX_ U8 *s, I32 off) { - return S_reghopmaybe3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr)); + dVAR; + return S_reghopmaybe3(s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr)); } STATIC U8 * -S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim) +S_reghopmaybe3(U8* s, I32 off, U8* lim) { + dVAR; if (off >= 0) { while (off-- && s < lim) { /* XXX could check well-formedness here */ @@ -4898,12 +4897,13 @@ S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim) static void restore_pos(pTHX_ void *arg) { - (void)arg; /* unused */ + dVAR; + PERL_UNUSED_ARG(arg); if (PL_reg_eval_set) { if (PL_reg_oldsaved) { PL_reg_re->subbeg = PL_reg_oldsaved; PL_reg_re->sublen = PL_reg_oldsavedlen; -#ifdef PERL_COPY_ON_WRITE +#ifdef PERL_OLD_COPY_ON_WRITE PL_reg_re->saved_copy = PL_nrs; #endif RX_MATCH_COPIED_on(PL_reg_re); @@ -4917,8 +4917,8 @@ restore_pos(pTHX_ void *arg) STATIC void S_to_utf8_substr(pTHX_ register regexp *prog) { - SV* sv; if (prog->float_substr && !prog->float_utf8) { + SV* sv; prog->float_utf8 = sv = newSVsv(prog->float_substr); sv_utf8_upgrade(sv); if (SvTAIL(prog->float_substr)) @@ -4927,6 +4927,7 @@ S_to_utf8_substr(pTHX_ register regexp *prog) prog->check_utf8 = sv; } if (prog->anchored_substr && !prog->anchored_utf8) { + SV* sv; prog->anchored_utf8 = sv = newSVsv(prog->anchored_substr); sv_utf8_upgrade(sv); if (SvTAIL(prog->anchored_substr)) @@ -4939,8 +4940,9 @@ S_to_utf8_substr(pTHX_ register regexp *prog) STATIC void S_to_byte_substr(pTHX_ register regexp *prog) { - SV* sv; + dVAR; if (prog->float_utf8 && !prog->float_substr) { + SV* sv; prog->float_substr = sv = newSVsv(prog->float_utf8); if (sv_utf8_downgrade(sv, TRUE)) { if (SvTAIL(prog->float_utf8)) @@ -4953,6 +4955,7 @@ S_to_byte_substr(pTHX_ register regexp *prog) prog->check_substr = sv; } if (prog->anchored_utf8 && !prog->anchored_substr) { + SV* sv; prog->anchored_substr = sv = newSVsv(prog->anchored_utf8); if (sv_utf8_downgrade(sv, TRUE)) { if (SvTAIL(prog->anchored_utf8))