X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=regexec.c;h=a65ded7b3ceec484dd1aa1b10c536bb786dacf61;hb=1aa6ea502f811472fe5fb23153ef6b09b3f470ec;hp=d412ef8471a4ec8f7b0fe408850b88d52389d4e1;hpb=d526390560c1ae208a087ad4d648b08895f79f8f;p=p5sagit%2Fp5-mst-13.2.git diff --git a/regexec.c b/regexec.c index d412ef8..a65ded7 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. @@ -179,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; @@ -223,6 +223,7 @@ S_regcppush(pTHX_ I32 parenfloor) STATIC char * S_regcppop(pTHX) { + dVAR; I32 i; U32 paren = 0; char *input; @@ -287,6 +288,7 @@ S_regcppop(pTHX) STATIC char * S_regcp_set_to(pTHX_ I32 ss) { + dVAR; const I32 tmp = PL_savestack_ix; PL_savestack_ix = ss; @@ -345,6 +347,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; @@ -404,6 +407,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; @@ -417,8 +421,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, char *check_at = Nullch; /* 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; @@ -519,6 +523,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; } } @@ -616,7 +621,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; @@ -862,7 +868,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); @@ -878,7 +884,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, @@ -1039,14 +1045,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++; @@ -1085,14 +1092,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, @@ -1119,8 +1125,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 @@ -1633,6 +1638,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; @@ -1651,7 +1657,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * GET_RE_DEBUG_FLAGS_DECL; - (void)data; /* Currently unused */ + PERL_UNUSED_ARG(data); RX_MATCH_UTF8_set(prog,do_utf8); PL_regcc = 0; @@ -1849,7 +1855,6 @@ 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) @@ -1949,8 +1954,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; @@ -1958,7 +1963,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; @@ -1994,7 +1999,7 @@ 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)) @@ -2103,6 +2108,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; @@ -2148,7 +2154,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); @@ -2194,7 +2200,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 @@ -2401,15 +2407,15 @@ S_regmatch(pTHX_ regnode *prog) 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); @@ -2417,6 +2423,7 @@ S_regmatch(pTHX_ regnode *prog) SV *re_debug_flags = NULL; #endif + U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY; GET_RE_DEBUG_FLAGS; @@ -2584,8 +2591,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; @@ -2614,7 +2619,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; @@ -2653,7 +2658,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; @@ -2680,7 +2684,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; @@ -2727,7 +2731,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; @@ -2762,7 +2766,7 @@ S_regmatch(pTHX_ regnode *prog) 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 ( besttype == RE_UNWIND_BRANCH ? NEXT_OFF(next) : ARG(next)))) next += n; @@ -4615,6 +4608,7 @@ S_regrepeat(pTHX_ const regnode *p, I32 max) STATIC I32 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp) { + dVAR; register char *scan = Nullch; register char *start; register char *loceol = PL_regeol; @@ -4665,6 +4659,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; @@ -4673,16 +4668,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) @@ -4724,9 +4719,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)) { @@ -4740,7 +4739,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)) @@ -4748,11 +4747,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; @@ -4837,12 +4835,14 @@ S_reginclass(pTHX_ register const regnode *n, register const U8* p, STRLEN* lenp STATIC U8 * S_reghop(pTHX_ U8 *s, I32 off) { + dVAR; return S_reghop3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr)); } STATIC U8 * S_reghop3(pTHX_ U8 *s, I32 off, U8* lim) { + dVAR; if (off >= 0) { while (off-- && s < lim) { /* XXX could check well-formedness here */ @@ -4867,12 +4867,14 @@ S_reghop3(pTHX_ U8 *s, I32 off, U8* lim) STATIC U8 * S_reghopmaybe(pTHX_ U8 *s, I32 off) { + dVAR; return S_reghopmaybe3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr)); } STATIC U8 * S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim) { + dVAR; if (off >= 0) { while (off-- && s < lim) { /* XXX could check well-formedness here */ @@ -4903,7 +4905,8 @@ 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; @@ -4922,8 +4925,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)) @@ -4932,6 +4935,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)) @@ -4944,8 +4948,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)) @@ -4958,6 +4963,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))