X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/890ce7af62ab97fd07b5b49562f13e94286469fb..03ca120dd65c92dac47010526eabc9f1009766e3:/regexec.c diff --git a/regexec.c b/regexec.c index 6a644d9..919a12b 100644 --- a/regexec.c +++ b/regexec.c @@ -78,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. @@ -178,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; @@ -222,6 +223,7 @@ S_regcppush(pTHX_ I32 parenfloor) STATIC char * S_regcppop(pTHX) { + dVAR; I32 i; U32 paren = 0; char *input; @@ -283,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; @@ -344,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; @@ -403,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; @@ -412,8 +405,8 @@ 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 const char * const i_strpos = strpos; @@ -518,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; } } @@ -838,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 @@ -878,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, @@ -963,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... */ @@ -1039,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++; @@ -1085,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, @@ -1119,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 @@ -1188,8 +1181,7 @@ 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 ? @@ -1231,8 +1223,7 @@ 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 ? @@ -1633,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; @@ -1645,8 +1637,8 @@ 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; @@ -1723,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; @@ -1849,9 +1841,9 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * "Did not find anchored character...\n") ); } - 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; @@ -1973,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; @@ -2000,7 +1992,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * last = strend - len + 1; else if (!multiline) last = memEQ(strend - len, little, len) - ? strend - len : Nullch; + ? strend - len : NULL; else goto find_last; } else { @@ -2102,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; @@ -2138,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; } @@ -2174,7 +2167,7 @@ S_regtry(pTHX_ regexp *prog, char *startpos) 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 */ } @@ -2322,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 ); \ @@ -2393,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; @@ -2430,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); @@ -2583,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; @@ -2652,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; @@ -2757,7 +2747,7 @@ 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, @@ -2808,8 +2798,7 @@ S_regmatch(pTHX_ regnode *prog) sayNO; if (NATIVE_TO_UNI(*(U8*)s) != utf8n_to_uvuni((U8*)l, UTF8_MAXBYTES, &ulen, - ckWARN(WARN_UTF8) ? - 0 : UTF8_ALLOW_ANY)) + uniflags)) sayNO; l += ulen; s ++; @@ -2823,8 +2812,7 @@ S_regmatch(pTHX_ regnode *prog) sayNO; if (NATIVE_TO_UNI(*((U8*)l)) != utf8n_to_uvuni((U8*)s, UTF8_MAXBYTES, &ulen, - ckWARN(WARN_UTF8) ? - 0 : UTF8_ALLOW_ANY)) + uniflags)) sayNO; s += ulen; l ++; @@ -3201,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]; @@ -3214,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) @@ -3231,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; @@ -3252,7 +3240,7 @@ S_regmatch(pTHX_ regnode *prog) } else { STRLEN len; - const char *t = SvPV_const(ret, len); + const char * const t = SvPV_const(ret, len); PMOP pm; char * const oprecomp = PL_regprecomp; const I32 osize = PL_regsize; @@ -3478,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 @@ -3491,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 */ @@ -3679,7 +3667,7 @@ S_regmatch(pTHX_ regnode *prog) cc->lastloc = lastloc; CACHEsayNO; } - /* NOT REACHED */ + /* NOTREACHED */ case BRANCHJ: next = scan + ARG(scan); if (next == scan) @@ -3695,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) @@ -3869,6 +3855,7 @@ S_regmatch(pTHX_ regnode *prog) } } sayNO; + /* NOTREACHED */ break; } case CURLYN: @@ -3941,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); } } } @@ -4011,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++; } @@ -4023,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; @@ -4060,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. */ @@ -4110,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); } @@ -4133,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); } @@ -4157,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; @@ -4303,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); @@ -4344,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--; @@ -4591,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); @@ -4613,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; @@ -4663,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; @@ -4673,14 +4662,14 @@ Perl_regclass_swash(pTHX_ register const regnode* node, bool doinit, SV** listsv if (PL_regdata->what[n] == 's') { SV * const rv = (SV*)PL_regdata->data[n]; AV * const av = (AV*)SvRV((SV*)rv); - SV **ary = AvARRAY(av); + 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) @@ -4722,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)) { @@ -4834,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 */ @@ -4864,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 */ @@ -4900,6 +4897,7 @@ S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim) static void restore_pos(pTHX_ void *arg) { + dVAR; PERL_UNUSED_ARG(arg); if (PL_reg_eval_set) { if (PL_reg_oldsaved) { @@ -4942,6 +4940,7 @@ S_to_utf8_substr(pTHX_ register regexp *prog) STATIC void S_to_byte_substr(pTHX_ register regexp *prog) { + dVAR; if (prog->float_utf8 && !prog->float_substr) { SV* sv; prog->float_substr = sv = newSVsv(prog->float_utf8);