X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/0473add9344e4535331a19ca65185739d954875b..b977d03a544315f8953421cd86f9236a4b3157de:/regcomp.c diff --git a/regcomp.c b/regcomp.c index 940fc42..0da8c1b 100644 --- a/regcomp.c +++ b/regcomp.c @@ -55,7 +55,6 @@ # define PERL_NO_GET_CONTEXT #endif -/*SUPPRESS 112*/ /* * pregcomp and pregexec -- regsub and regerror are not used in perl * @@ -80,7 +79,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. @@ -206,8 +205,8 @@ typedef struct scan_data_t { * Forward declarations for pregcomp()'s friends. */ -static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0}; +static const scan_data_t zero_scan_data = + { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; #define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL) #define SF_BEFORE_SEOL 0x1 @@ -283,31 +282,10 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, } STMT_END /* - * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given - * args. Show regex, up to a maximum length. If it's too long, chop and add - * "...". - */ -#define FAIL2(pat,msg) STMT_START { \ - const char *ellipses = ""; \ - IV len = RExC_end - RExC_precomp; \ - \ - if (!SIZE_ONLY) \ - SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \ - if (len > RegexLengthToShowInErrorMessages) { \ - /* chop 10 shorter than the max, to ensure meaning of "..." */ \ - len = RegexLengthToShowInErrorMessages - 10; \ - ellipses = "..."; \ - } \ - S_re_croak2(aTHX_ pat, " in regex m/%.*s%s/", \ - msg, (int)len, RExC_precomp, ellipses); \ -} STMT_END - - -/* * Simple_vFAIL -- like FAIL, but marks the current location in the scan */ #define Simple_vFAIL(m) STMT_START { \ - IV offset = RExC_parse - RExC_precomp; \ + const IV offset = RExC_parse - RExC_precomp; \ Perl_croak(aTHX_ "%s" REPORT_LOCATION, \ m, (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END @@ -325,7 +303,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, * Like Simple_vFAIL(), but accepts two arguments. */ #define Simple_vFAIL2(m,a1) STMT_START { \ - IV offset = RExC_parse - RExC_precomp; \ + const IV offset = RExC_parse - RExC_precomp; \ S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, \ (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END @@ -344,7 +322,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, * Like Simple_vFAIL(), but accepts three arguments. */ #define Simple_vFAIL3(m, a1, a2) STMT_START { \ - IV offset = RExC_parse - RExC_precomp; \ + const IV offset = RExC_parse - RExC_precomp; \ S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, \ (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END @@ -362,29 +340,19 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, * Like Simple_vFAIL(), but accepts four arguments. */ #define Simple_vFAIL4(m, a1, a2, a3) STMT_START { \ - IV offset = RExC_parse - RExC_precomp; \ + const IV offset = RExC_parse - RExC_precomp; \ S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3, \ (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END -/* - * Like Simple_vFAIL(), but accepts five arguments. - */ -#define Simple_vFAIL5(m, a1, a2, a3, a4) STMT_START { \ - IV offset = RExC_parse - RExC_precomp; \ - S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3, a4, \ - (int)offset, RExC_precomp, RExC_precomp + offset); \ -} STMT_END - - #define vWARN(loc,m) STMT_START { \ - IV offset = loc - RExC_precomp; \ + const IV offset = loc - RExC_precomp; \ Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s" REPORT_LOCATION, \ m, (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END #define vWARNdep(loc,m) STMT_START { \ - IV offset = loc - RExC_precomp; \ + const IV offset = loc - RExC_precomp; \ Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP), \ "%s" REPORT_LOCATION, \ m, (int)offset, RExC_precomp, RExC_precomp + offset); \ @@ -392,25 +360,25 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #define vWARN2(loc, m, a1) STMT_START { \ - IV offset = loc - RExC_precomp; \ + const IV offset = loc - RExC_precomp; \ Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \ a1, (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END #define vWARN3(loc, m, a1, a2) STMT_START { \ - IV offset = loc - RExC_precomp; \ + const IV offset = loc - RExC_precomp; \ Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \ a1, a2, (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END #define vWARN4(loc, m, a1, a2, a3) STMT_START { \ - IV offset = loc - RExC_precomp; \ + const IV offset = loc - RExC_precomp; \ Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \ a1, a2, a3, (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END #define vWARN5(loc, m, a1, a2, a3, a4) STMT_START { \ - IV offset = loc - RExC_precomp; \ + const IV offset = loc - RExC_precomp; \ Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \ a1, a2, a3, a4, (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END @@ -436,7 +404,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n", \ __LINE__, (node), (byte))); \ if((node) < 0) { \ - Perl_croak(aTHX_ "value of node is %d in Offset macro", node); \ + Perl_croak(aTHX_ "value of node is %d in Offset macro", (int)(node)); \ } else { \ RExC_offsets[2*(node)-1] = (byte); \ } \ @@ -450,9 +418,9 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #define Set_Node_Length_To_R(node,len) STMT_START { \ if (! SIZE_ONLY) { \ MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n", \ - __LINE__, (node), (len))); \ + __LINE__, (int)(node), (int)(len))); \ if((node) < 0) { \ - Perl_croak(aTHX_ "value of node is %d in Length macro", node); \ + Perl_croak(aTHX_ "value of node is %d in Length macro", (int)(node)); \ } else { \ RExC_offsets[2*(node)] = (len); \ } \ @@ -507,10 +475,10 @@ S_scan_commit(pTHX_ RExC_state_t *pRExC_state, scan_data_t *data) } SvCUR_set(data->last_found, 0); { - SV * sv = data->last_found; - MAGIC *mg = + SV * const sv = data->last_found; + MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL; - if (mg && mg->mg_len > 0) + if (mg) mg->mg_len = 0; } data->last_end = -1; @@ -530,7 +498,7 @@ S_cl_anything(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *c /* Can match anything (initialization) */ STATIC int -S_cl_is_anything(pTHX_ struct regnode_charclass_class *cl) +S_cl_is_anything(pTHX_ const struct regnode_charclass_class *cl) { int value; @@ -567,7 +535,7 @@ S_cl_init_zero(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class * /* We assume that cl is not inverted */ STATIC void S_cl_and(pTHX_ struct regnode_charclass_class *cl, - struct regnode_charclass_class *and_with) + const struct regnode_charclass_class *and_with) { if (!(and_with->flags & ANYOF_CLASS) && !(cl->flags & ANYOF_CLASS) @@ -603,7 +571,7 @@ S_cl_and(pTHX_ struct regnode_charclass_class *cl, /* 'OR' a given class with another one. Can create false positives */ /* We assume that cl is not inverted */ STATIC void -S_cl_or(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, struct regnode_charclass_class *or_with) +S_cl_or(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, const struct regnode_charclass_class *or_with) { if (or_with->flags & ANYOF_INVERT) { /* We do not use @@ -674,7 +642,7 @@ S_cl_or(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, str /* REx optimizer. Converts nodes into quickier variants "in place". Finds fixed substrings. */ -/* Stops at toplevel WHILEM as well as at `last'. At end *scanp is set +/* Stops at toplevel WHILEM as well as at "last". At end *scanp is set to the position after last scanned or to NULL. */ STATIC I32 @@ -722,8 +690,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg n = regnext(n); } else if (stringok) { - int oldl = STR_LEN(scan); - regnode *nnext = regnext(n); + const int oldl = STR_LEN(scan); + regnode * const nnext = regnext(n); if (oldl + STR_LEN(n) > U8_MAX) break; @@ -768,11 +736,12 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg another valid sequence of UTF-8 bytes. */ - char *s0 = STRING(scan), *s, *t; - char *s1 = s0 + STR_LEN(scan) - 1, *s2 = s1 - 4; - const char *t0 = "\xcc\x88\xcc\x81"; - const char *t1 = t0 + 3; - + char * const s0 = STRING(scan), *s, *t; + char * const s1 = s0 + STR_LEN(scan) - 1; + char * const s2 = s1 - 4; + const char * const t0 = "\xcc\x88\xcc\x81"; + const char * const t1 = t0 + 3; + for (s = s0 + 2; s < s2 && (t = ninstr(s, s1, t0, t1)); s = t + 4) { @@ -797,7 +766,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg /* Follow the next-chain of the current node and optimize away all the NOTHINGs from it. */ if (OP(scan) != CURLYX) { - int max = (reg_off_by_arg[OP(scan)] + const int max = (reg_off_by_arg[OP(scan)] ? I32_MAX /* I32 may be smaller than U16 on CRAYs! */ : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX)); @@ -909,6 +878,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg data->start_class->flags |= ANYOF_EOS; } } + } else if (code == BRANCHJ) /* single branch is optimized. */ scan = NEXTOPER(NEXTOPER(scan)); @@ -918,11 +888,13 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg } else if (OP(scan) == EXACT) { I32 l = STR_LEN(scan); - UV uc = *((U8*)STRING(scan)); + UV uc; if (UTF) { - U8 *s = (U8*)STRING(scan); - l = utf8_length(s, s + l); - uc = utf8_to_uvchr(s, NULL); + const U8 * const s = (U8*)STRING(scan); + l = utf8_length((U8 *)s, (U8 *)s + l); + uc = utf8_to_uvchr((U8 *)s, NULL); + } else { + uc = *((U8*)STRING(scan)); } min += l; if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */ @@ -934,16 +906,16 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg ? I32_MAX : data->pos_min + data->pos_delta; } sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan)); + if (UTF) + SvUTF8_on(data->last_found); { - SV * sv = data->last_found; - MAGIC *mg = SvUTF8(sv) && SvMAGICAL(sv) ? + SV * const sv = data->last_found; + MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL; if (mg && mg->mg_len >= 0) mg->mg_len += utf8_length((U8*)STRING(scan), (U8*)STRING(scan)+STR_LEN(scan)); } - if (UTF) - SvUTF8_on(data->last_found); data->last_end = data->pos_min + l; data->pos_min += l; /* As in the first entry. */ data->flags &= ~SF_BEFORE_EOL; @@ -986,7 +958,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg if (flags & SCF_DO_SUBSTR) scan_commit(pRExC_state, data); if (UTF) { - U8 *s = (U8 *)STRING(scan); + U8 * const s = (U8 *)STRING(scan); l = utf8_length(s, s + l); uc = utf8_to_uvchr(s, NULL); } @@ -1137,12 +1109,12 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg } if (!scan) /* It was not CURLYX, but CURLY. */ scan = next; - if (ckWARN(WARN_REGEXP) - /* ? quantifier ok, except for (?{ ... }) */ - && (next_is_eval || !(mincount == 0 && maxcount == 1)) + if ( /* ? quantifier ok, except for (?{ ... }) */ + (next_is_eval || !(mincount == 0 && maxcount == 1)) && (minnext == 0) && (deltanext == 0) && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR)) - && maxcount <= REG_INFTY/3) /* Complement check for big count */ + && maxcount <= REG_INFTY/3 /* Complement check for big count */ + && ckWARN(WARN_REGEXP)) { vWARN(RExC_parse, "Quantifier unexpected on zero-length expression"); @@ -1268,14 +1240,14 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg if (data && fl & (SF_HAS_PAR|SF_IN_PAR)) pars++; if (flags & SCF_DO_SUBSTR) { - SV *last_str = Nullsv; + SV *last_str = NULL; int counted = mincount != 0; if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */ #if defined(SPARC64_GCC_WORKAROUND) I32 b = 0; STRLEN l = 0; - char *s = NULL; + const char *s = NULL; I32 old = 0; if (pos_before >= data->last_start_min) @@ -1284,14 +1256,14 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg b = data->last_start_min; l = 0; - s = SvPV(data->last_found, l); + s = SvPV_const(data->last_found, l); old = b - data->last_start_min; #else I32 b = pos_before >= data->last_start_min ? pos_before : data->last_start_min; STRLEN l; - char *s = SvPV(data->last_found, l); + const char *s = SvPV_const(data->last_found, l); I32 old = b - data->last_start_min; #endif @@ -1308,7 +1280,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg if (mincount > 1) { SvGROW(last_str, (mincount * l) + 1); repeatcpy(SvPVX(last_str) + l, - SvPVX(last_str), l, mincount - 1); + SvPVX_const(last_str), l, mincount - 1); SvCUR_set(last_str, SvCUR(last_str) * mincount); /* Add additional parts. */ SvCUR_set(data->last_found, @@ -1340,7 +1312,13 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg the group. */ scan_commit(pRExC_state,data); if (mincount && last_str) { - sv_setsv(data->last_found, last_str); + SV *sv = data->last_found; + MAGIC *mg = SvUTF8(sv) && SvMAGICAL(sv) ? + mg_find(sv, PERL_MAGIC_utf8) : NULL; + + if (mg) + mg->mg_len = -1; + sv_setsv(sv, last_str); data->last_end = data->pos_min; data->last_start_min = data->pos_min - CHR_SVLEN(last_str); @@ -1623,7 +1601,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg if (data) data->whilem_c = data_fake.whilem_c; if (f & SCF_DO_STCLASS_AND) { - int was = (data->start_class->flags & ANYOF_EOS); + const int was = (data->start_class->flags & ANYOF_EOS); cl_and(data->start_class, &intrnl); if (was) @@ -1692,9 +1670,9 @@ S_add_data(pTHX_ RExC_state_t *pRExC_state, I32 n, const char *s) RExC_rx->data->count += n; } else { - Newc(1207, RExC_rx->data, sizeof(*RExC_rx->data) + sizeof(void*) * (n - 1), + Newxc(RExC_rx->data, sizeof(*RExC_rx->data) + sizeof(void*) * (n - 1), char, struct reg_data); - New(1208, RExC_rx->data->what, n, U8); + Newx(RExC_rx->data->what, n, U8); RExC_rx->data->count = n; } Copy(s, RExC_rx->data->what + RExC_rx->data->count - n, n, U8); @@ -1704,23 +1682,24 @@ S_add_data(pTHX_ RExC_state_t *pRExC_state, I32 n, const char *s) void Perl_reginitcolors(pTHX) { - int i = 0; - char *s = PerlEnv_getenv("PERL_RE_COLORS"); - + const char * const s = PerlEnv_getenv("PERL_RE_COLORS"); if (s) { - PL_colors[0] = s = savepv(s); + char *t = savepv(s); + int i = 0; + PL_colors[0] = t; while (++i < 6) { - s = strchr(s, '\t'); - if (s) { - *s = '\0'; - PL_colors[i] = ++s; + t = strchr(t, '\t'); + if (t) { + *t = '\0'; + PL_colors[i] = ++t; } else - PL_colors[i] = s = (char *)""; + PL_colors[i] = t = (char *)""; } } else { + int i = 0; while (i < 6) - PL_colors[i++] = ""; + PL_colors[i++] = (char *)""; } PL_colorset = 1; } @@ -1789,7 +1768,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) REGC((U8)REG_MAGIC, (char*)RExC_emit); #endif if (reg(pRExC_state, 0, &flags) == NULL) { - RExC_precomp = Nullch; + RExC_precomp = NULL; return(NULL); } DEBUG_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" ", (IV)RExC_size)); @@ -1804,7 +1783,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) RExC_whilem_seen = 15; /* Allocate space and initialize. */ - Newc(1001, r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode), + Newxc(r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode), char, regexp); if (r == NULL) FAIL("Regexp out of space"); @@ -1819,18 +1798,19 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) r->subbeg = NULL; r->reganch = pm->op_pmflags & PMf_COMPILETIME; r->nparens = RExC_npar - 1; /* set early to validate backrefs */ + r->lastparen = 0; /* mg.c reads this. */ r->substrs = 0; /* Useful during FAIL. */ r->startp = 0; /* Useful during FAIL. */ r->endp = 0; /* Useful during FAIL. */ - Newz(1304, r->offsets, 2*RExC_size+1, U32); /* MJD 20001228 */ + Newxz(r->offsets, 2*RExC_size+1, U32); /* MJD 20001228 */ if (r->offsets) { - r->offsets[0] = RExC_size; + r->offsets[0] = RExC_size; } DEBUG_r(PerlIO_printf(Perl_debug_log, - "%s %"UVuf" bytes for offset annotations.\n", - r->offsets ? "Got" : "Couldn't get", + "%s %"UVuf" bytes for offset annotations.\n", + r->offsets ? "Got" : "Couldn't get", (UV)((2*RExC_size+1) * sizeof(U32)))); RExC_rx = r; @@ -1862,7 +1842,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) /* XXXX To minimize changes to RE engine we always allocate 3-units-long substrs field. */ - Newz(1004, r->substrs, 1, struct reg_substr_data); + Newxz(r->substrs, 1, struct reg_substr_data); StructCopy(&zero_scan_data, &data, scan_data_t); /* XXXX Should not we check for something else? Usually it is OPEN1... */ @@ -1921,13 +1901,10 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) !(r->reganch & ROPT_ANCH) ) { /* turn .* into ^.* with an implied $*=1 */ - int type = OP(NEXTOPER(first)); - - if (type == REG_ANY) - type = ROPT_ANCH_MBOL; - else - type = ROPT_ANCH_SBOL; - + const int type = + (OP(NEXTOPER(first)) == REG_ANY) + ? ROPT_ANCH_MBOL + : ROPT_ANCH_SBOL; r->reganch |= type | ROPT_IMPLICIT; first = NEXTOPER(first); goto again; @@ -1953,9 +1930,9 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) */ minlen = 0; - data.longest_fixed = newSVpvn("",0); - data.longest_float = newSVpvn("",0); - data.last_found = newSVpvn("",0); + data.longest_fixed = newSVpvs(""); + data.longest_float = newSVpvs(""); + data.last_found = newSVpvs(""); data.longest = &(data.longest_fixed); first = scan; if (!r->regstclass) { @@ -1990,10 +1967,10 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) if (SvUTF8(data.longest_float)) { r->float_utf8 = data.longest_float; - r->float_substr = Nullsv; + r->float_substr = NULL; } else { r->float_substr = data.longest_float; - r->float_utf8 = Nullsv; + r->float_utf8 = NULL; } r->float_min_offset = data.offset_float_min; r->float_max_offset = data.offset_float_max; @@ -2004,7 +1981,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) } else { remove_float: - r->float_substr = r->float_utf8 = Nullsv; + r->float_substr = r->float_utf8 = NULL; SvREFCNT_dec(data.longest_float); longest_float_length = 0; } @@ -2018,10 +1995,10 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) if (SvUTF8(data.longest_fixed)) { r->anchored_utf8 = data.longest_fixed; - r->anchored_substr = Nullsv; + r->anchored_substr = NULL; } else { r->anchored_substr = data.longest_fixed; - r->anchored_utf8 = Nullsv; + r->anchored_utf8 = NULL; } r->anchored_offset = data.offset_fixed; t = (data.flags & SF_FIX_BEFORE_EOL /* Can't have SEOL and MULTI */ @@ -2030,7 +2007,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) fbm_compile(data.longest_fixed, t ? FBMcf_TAIL : 0); } else { - r->anchored_substr = r->anchored_utf8 = Nullsv; + r->anchored_substr = r->anchored_utf8 = NULL; SvREFCNT_dec(data.longest_fixed); longest_fixed_length = 0; } @@ -2042,9 +2019,9 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) && !(data.start_class->flags & ANYOF_EOS) && !cl_is_anything(data.start_class)) { - I32 n = add_data(pRExC_state, 1, "f"); + const I32 n = add_data(pRExC_state, 1, "f"); - New(1006, RExC_rx->data->data[n], 1, + Newx(RExC_rx->data->data[n], 1, struct regnode_charclass_class); StructCopy(data.start_class, (struct regnode_charclass_class*)RExC_rx->data->data[n], @@ -2055,8 +2032,8 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) DEBUG_r({ SV *sv = sv_newmortal(); regprop(sv, (regnode*)data.start_class); PerlIO_printf(Perl_debug_log, - "synthetic stclass `%s'.\n", - SvPVX(sv));}); + "synthetic stclass \"%s\".\n", + SvPVX_const(sv));}); } /* A temporary algorithm prefers floated substr to fixed one to dig more info. */ @@ -2094,13 +2071,13 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) data.last_closep = &last_close; minlen = study_chunk(pRExC_state, &scan, &fake, scan + RExC_size, &data, SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS); r->check_substr = r->check_utf8 = r->anchored_substr = r->anchored_utf8 - = r->float_substr = r->float_utf8 = Nullsv; + = r->float_substr = r->float_utf8 = NULL; if (!(data.start_class->flags & ANYOF_EOS) && !cl_is_anything(data.start_class)) { - I32 n = add_data(pRExC_state, 1, "f"); + const I32 n = add_data(pRExC_state, 1, "f"); - New(1006, RExC_rx->data->data[n], 1, + Newx(RExC_rx->data->data[n], 1, struct regnode_charclass_class); StructCopy(data.start_class, (struct regnode_charclass_class*)RExC_rx->data->data[n], @@ -2110,8 +2087,8 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) DEBUG_r({ SV* sv = sv_newmortal(); regprop(sv, (regnode*)data.start_class); PerlIO_printf(Perl_debug_log, - "synthetic stclass `%s'.\n", - SvPVX(sv));}); + "synthetic stclass \"%s\".\n", + SvPVX_const(sv));}); } } @@ -2124,8 +2101,8 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) r->reganch |= ROPT_EVAL_SEEN; if (RExC_seen & REG_SEEN_CANY) r->reganch |= ROPT_CANY_SEEN; - Newz(1002, r->startp, RExC_npar, I32); - Newz(1002, r->endp, RExC_npar, I32); + Newxz(r->startp, RExC_npar, I32); + Newxz(r->endp, RExC_npar, I32); PL_regdata = r->data; /* for regprop() */ DEBUG_r(regdump(r)); return(r); @@ -2147,22 +2124,24 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) register regnode *ret; /* Will be the head of the group. */ register regnode *br; register regnode *lastbr; - register regnode *ender = 0; + register regnode *ender = NULL; register I32 parno = 0; - I32 flags, oregflags = RExC_flags, have_branch = 0, open = 0; + I32 flags; + const I32 oregflags = RExC_flags; + bool have_branch = 0; + bool is_open = 0; /* for (?g), (?gc), and (?o) warnings; warning about (?c) will warn about (?g) -- japhy */ - I32 wastedflags = 0x00, - wasted_o = 0x01, - wasted_g = 0x02, - wasted_gc = 0x02 | 0x04, - wasted_c = 0x04; +#define WASTED_O 0x01 +#define WASTED_G 0x02 +#define WASTED_C 0x04 +#define WASTED_GC (0x02|0x04) + I32 wastedflags = 0x00; char * parse_start = RExC_parse; /* MJD */ - char *oregcomp_parse = RExC_parse; - char c; + char * const oregcomp_parse = RExC_parse; *flagp = 0; /* Tentatively. */ @@ -2172,8 +2151,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) if (*RExC_parse == '?') { /* (?...) */ U32 posflags = 0, negflags = 0; U32 *flagsp = &posflags; - int logical = 0; - char *seqstart = RExC_parse; + bool is_logical = 0; + const char * const seqstart = RExC_parse; RExC_parse++; paren = *RExC_parse++; @@ -2209,7 +2188,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) vWARNdep(RExC_parse, "(?p{}) is deprecated - use (??{})"); /* FALL THROUGH*/ case '?': /* (??...) */ - logical = 1; + is_logical = 1; if (*RExC_parse != '{') goto unknown; paren = *RExC_parse++; @@ -2219,32 +2198,28 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) I32 count = 1, n = 0; char c; char *s = RExC_parse; - SV *sv; - OP_4tree *sop, *rop; RExC_seen_zerolen++; RExC_seen |= REG_SEEN_EVAL; while (count && (c = *RExC_parse)) { - if (c == '\\' && RExC_parse[1]) - RExC_parse++; + if (c == '\\') { + if (RExC_parse[1]) + RExC_parse++; + } else if (c == '{') count++; else if (c == '}') count--; RExC_parse++; } - if (*RExC_parse != ')') - { + if (*RExC_parse != ')') { RExC_parse = s; vFAIL("Sequence (?{...}) not terminated or not {}-balanced"); } if (!SIZE_ONLY) { PAD *pad; - - if (RExC_parse - 1 - s) - sv = newSVpvn(s, RExC_parse - 1 - s); - else - sv = newSVpvn("", 0); + OP_4tree *sop, *rop; + SV * const sv = newSVpvn(s, RExC_parse - 1 - s); ENTER; Perl_save_re_context(aTHX); @@ -2271,7 +2246,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) } nextchar(pRExC_state); - if (logical) { + if (is_logical) { ret = reg_node(pRExC_state, LOGICAL); if (!SIZE_ONLY) ret->flags = 2; @@ -2301,12 +2276,13 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) } else if (RExC_parse[0] >= '1' && RExC_parse[0] <= '9' ) { /* (?(1)...) */ + char c; parno = atoi(RExC_parse++); while (isDIGIT(*RExC_parse)) RExC_parse++; ret = reganode(pRExC_state, GROUPP, parno); - + if ((c = *nextchar(pRExC_state)) != ')') vFAIL("Switch condition not recognized"); insert_if: @@ -2358,7 +2334,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) if (*RExC_parse == 'o' || *RExC_parse == 'g') { if (SIZE_ONLY && ckWARN(WARN_REGEXP)) { - I32 wflagbit = *RExC_parse == 'o' ? wasted_o : wasted_g; + const I32 wflagbit = *RExC_parse == 'o' ? WASTED_O : WASTED_G; if (! (wastedflags & wflagbit) ) { wastedflags |= wflagbit; vWARN5( @@ -2374,8 +2350,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) } else if (*RExC_parse == 'c') { if (SIZE_ONLY && ckWARN(WARN_REGEXP)) { - if (! (wastedflags & wasted_c) ) { - wastedflags |= wasted_gc; + if (! (wastedflags & WASTED_C) ) { + wastedflags |= WASTED_GC; vWARN3( RExC_parse + 1, "Useless (%sc) - %suse /gc modifier", @@ -2418,7 +2394,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) ret = reganode(pRExC_state, OPEN, parno); Set_Node_Length(ret, 1); /* MJD */ Set_Node_Offset(ret, RExC_parse); /* MJD */ - open = 1; + is_open = 1; } } else /* ! paren */ @@ -2428,7 +2404,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) parse_start = RExC_parse; /* MJD */ br = regbranch(pRExC_state, &flags, 1); /* branch_len = (paren != 0); */ - + if (br == NULL) return(NULL); if (*RExC_parse == '|') { @@ -2447,7 +2423,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) else if (paren == ':') { *flagp |= flags&SIMPLE; } - if (open) { /* Starts with OPEN. */ + if (is_open) { /* Starts with OPEN. */ regtail(pRExC_state, ret, br); /* OPEN -> first. */ } else if (paren != '?') /* Not Conditional */ @@ -2463,7 +2439,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) RExC_extralen += 2; /* Account for LONGJMP. */ nextchar(pRExC_state); br = regbranch(pRExC_state, &flags, 0); - + if (br == NULL) return(NULL); regtail(pRExC_state, lastbr, br); /* BRANCH -> BRANCH. */ @@ -2625,7 +2601,7 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) register char op; register char *next; I32 flags; - char *origparse = RExC_parse; + const char * const origparse = RExC_parse; char *maxpos; I32 min; I32 max = REG_INFTY; @@ -2643,7 +2619,7 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) if (op == '{' && regcurly(RExC_parse)) { parse_start = RExC_parse; /* MJD */ next = RExC_parse + 1; - maxpos = Nullch; + maxpos = NULL; while (isDIGIT(*next) || *next == ',') { if (*next == ',') { if (maxpos) @@ -2690,9 +2666,9 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) reginsert(pRExC_state, CURLYX,ret); /* MJD hk */ Set_Node_Offset(ret, parse_start+1); - Set_Node_Length(ret, + Set_Node_Length(ret, op == '{' ? (RExC_parse - parse_start) : 1); - + if (!SIZE_ONLY && RExC_extralen) NEXT_OFF(ret) = 3; /* Go over NOTHING to LONGJMP. */ regtail(pRExC_state, ret, reg_node(pRExC_state, NOTHING)); @@ -2766,10 +2742,10 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) goto do_curly; } nest_check: - if (ckWARN(WARN_REGEXP) && !SIZE_ONLY && !(flags&HASWIDTH) && max > REG_INFTY/3) { + if (!SIZE_ONLY && !(flags&HASWIDTH) && max > REG_INFTY/3 && ckWARN(WARN_REGEXP)) { vWARN3(RExC_parse, "%.*s matches null string many times", - RExC_parse - origparse, + (int)(RExC_parse >= origparse ? RExC_parse - origparse : 0), origparse); } @@ -2798,7 +2774,7 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) STATIC regnode * S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) { - register regnode *ret = 0; + register regnode *ret = NULL; I32 flags; char *parse_start = RExC_parse; @@ -3031,7 +3007,7 @@ tryagain: case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': { - I32 num = atoi(RExC_parse); + const I32 num = atoi(RExC_parse); if (num > 9 && num >= RExC_npar) goto defchar; @@ -3047,9 +3023,9 @@ tryagain: (U8)(FOLD ? (LOC ? REFFL : REFF) : REF), num); *flagp |= HASWIDTH; - + /* override incorrect value set in reganode MJD */ - Set_Node_Offset(ret, parse_start+1); + Set_Node_Offset(ret, parse_start+1); Set_Node_Cur_Length(ret); /* MJD */ RExC_parse--; nextchar(pRExC_state); @@ -3061,7 +3037,7 @@ tryagain: FAIL("Trailing \\"); /* FALL THROUGH */ default: - /* Do not generate `unrecognized' warnings here, we fall + /* Do not generate "unrecognized" warnings here, we fall back into the quick-grab loop below */ parse_start--; goto defchar; @@ -3081,7 +3057,6 @@ tryagain: register UV ender; register char *p; char *oldp, *s; - STRLEN numlen; STRLEN foldlen; U8 tmpbuf[UTF8_MAXBYTES_CASE+1], *foldbuf; @@ -3157,7 +3132,7 @@ tryagain: break; case 'x': if (*++p == '{') { - char* e = strchr(p, '}'); + char* const e = strchr(p, '}'); if (!e) { RExC_parse = p + 1; @@ -3166,7 +3141,7 @@ tryagain: else { I32 flags = PERL_SCAN_ALLOW_UNDERSCORES | PERL_SCAN_DISALLOW_PREFIX; - numlen = e - p - 1; + STRLEN numlen = e - p - 1; ender = grok_hex(p + 1, &numlen, &flags, NULL); if (ender > 0xff) RExC_utf8 = 1; @@ -3175,7 +3150,7 @@ tryagain: } else { I32 flags = PERL_SCAN_DISALLOW_PREFIX; - numlen = 2; + STRLEN numlen = 2; ender = grok_hex(p, &numlen, &flags, NULL); p += numlen; } @@ -3190,7 +3165,7 @@ tryagain: if (*p == '0' || (isDIGIT(p[1]) && atoi(p) >= RExC_npar) ) { I32 flags = 0; - numlen = 3; + STRLEN numlen = 3; ender = grok_oct(p, &numlen, &flags, NULL); p += numlen; } @@ -3204,7 +3179,7 @@ tryagain: FAIL("Trailing \\"); /* FALL THROUGH */ default: - if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(*p)) + if (!SIZE_ONLY&& isALPHA(*p) && ckWARN(WARN_REGEXP)) vWARN2(p + 1, "Unrecognized escape \\%c passed through", UCHARAT(p)); goto normal_default; } @@ -3212,6 +3187,7 @@ tryagain: default: normal_default: if (UTF8_IS_START(*p) && UTF) { + STRLEN numlen; ender = utf8n_to_uvchr((U8*)p, RExC_end - p, &numlen, 0); p += numlen; @@ -3234,6 +3210,7 @@ tryagain: if (FOLD) { /* Emit all the Unicode characters. */ + STRLEN numlen; for (foldbuf = tmpbuf; foldlen; foldlen -= numlen) { @@ -3271,6 +3248,7 @@ tryagain: if (FOLD) { /* Emit all the Unicode characters. */ + STRLEN numlen; for (foldbuf = tmpbuf; foldlen; foldlen -= numlen) { @@ -3334,8 +3312,8 @@ tryagain: if (RExC_utf8) SvUTF8_on(sv); if (sv_utf8_downgrade(sv, TRUE)) { - char *s = sv_recode_to_utf8(sv, PL_encoding); - STRLEN newlen = SvCUR(sv); + const char * const s = sv_recode_to_utf8(sv, PL_encoding); + const STRLEN newlen = SvCUR(sv); if (SvUTF8(sv)) RExC_utf8 = 1; @@ -3355,7 +3333,7 @@ tryagain: } STATIC char * -S_regwhite(pTHX_ char *p, char *e) +S_regwhite(pTHX_ char *p, const char *e) { while (p < e) { if (isSPACE(*p)) @@ -3384,13 +3362,12 @@ S_regwhite(pTHX_ char *p, char *e) STATIC I32 S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value) { - char *posixcc = 0; I32 namedclass = OOB_NAMEDCLASS; if (value == '[' && RExC_parse + 1 < RExC_end && /* I smell either [: or [= or [. -- POSIX has been here, right? */ POSIXCC(UCHARAT(RExC_parse))) { - char c = UCHARAT(RExC_parse); + const char c = UCHARAT(RExC_parse); char* s = RExC_parse++; while (RExC_parse < RExC_end && UCHARAT(RExC_parse) != c) @@ -3399,7 +3376,8 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value) /* Grandfather lone [:, [=, [. */ RExC_parse = s; else { - char* t = RExC_parse++; /* skip over the c */ + const char* t = RExC_parse++; /* skip over the c */ + const char *posixcc; assert(*t == c); @@ -3407,8 +3385,8 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value) RExC_parse++; /* skip over the ending ] */ posixcc = s + 1; if (*s == ':') { - I32 complement = *posixcc == '^' ? *posixcc++ : 0; - I32 skip = t - posixcc; + const I32 complement = *posixcc == '^' ? *posixcc++ : 0; + const I32 skip = t - posixcc; /* Initially switch on the length of the name. */ switch (skip) { @@ -3544,8 +3522,8 @@ STATIC void S_checkposixcc(pTHX_ RExC_state_t *pRExC_state) { if (!SIZE_ONLY && POSIXCC(UCHARAT(RExC_parse))) { - char *s = RExC_parse; - char c = *s++; + const char *s = RExC_parse; + const char c = *s++; while(*s && isALNUM(*s)) s++; @@ -3577,13 +3555,13 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) register regnode *ret; STRLEN numlen; IV namedclass; - char *rangebegin = 0; + char *rangebegin = NULL; bool need_class = 0; - SV *listsv = Nullsv; + SV *listsv = NULL; register char *e; UV n; bool optimize_invert = TRUE; - AV* unicode_alternate = 0; + AV* unicode_alternate = NULL; #ifdef EBCDIC UV literal_endpoint = 0; #endif @@ -3609,7 +3587,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) if (LOC) ANYOF_FLAGS(ret) |= ANYOF_LOCALE; ANYOF_BITMAP_ZERO(ret); - listsv = newSVpvn("# comment\n", 10); + listsv = newSVpvs("# comment\n"); } nextvalue = RExC_parse < RExC_end ? UCHARAT(RExC_parse) : 0; @@ -3666,7 +3644,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) if (RExC_parse >= RExC_end) vFAIL2("Empty \\%c{}", (U8)value); if (*RExC_parse == '{') { - U8 c = (U8)value; + const U8 c = (U8)value; e = strchr(RExC_parse++, '}'); if (!e) vFAIL2("Missing right brace on \\%c{}", c); @@ -3743,7 +3721,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) break; } default: - if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(value)) + if (!SIZE_ONLY && isALPHA(value) && ckWARN(WARN_REGEXP)) vWARN2(RExC_parse, "Unrecognized escape \\%c in character class passed through", (int)value); @@ -3765,12 +3743,16 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) /* a bad range like a-\d, a-[:digit:] ? */ if (range) { if (!SIZE_ONLY) { - if (ckWARN(WARN_REGEXP)) + if (ckWARN(WARN_REGEXP)) { + int w = + RExC_parse >= rangebegin ? + RExC_parse - rangebegin : 0; vWARN4(RExC_parse, "False [] range \"%*.*s\"", - RExC_parse - rangebegin, - RExC_parse - rangebegin, + w, + w, rangebegin); + } if (prevvalue < 256) { ANYOF_BITMAP_SET(ret, prevvalue); ANYOF_BITMAP_SET(ret, '-'); @@ -4174,12 +4156,16 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) /* a bad range like \w-, [:word:]- ? */ if (namedclass > OOB_NAMEDCLASS) { - if (ckWARN(WARN_REGEXP)) + if (ckWARN(WARN_REGEXP)) { + int w = + RExC_parse >= rangebegin ? + RExC_parse - rangebegin : 0; vWARN4(RExC_parse, "False [] range \"%*.*s\"", - RExC_parse - rangebegin, - RExC_parse - rangebegin, + w, + w, rangebegin); + } if (!SIZE_ONLY) ANYOF_BITMAP_SET(ret, '-'); } else @@ -4193,7 +4179,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) IV i; if (prevvalue < 256) { - IV ceilvalue = value < 256 ? value : 255; + const IV ceilvalue = value < 256 ? value : 255; #ifdef EBCDIC /* In EBCDIC [\x89-\x91] should include @@ -4218,8 +4204,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) ANYOF_BITMAP_SET(ret, i); } if (value > 255 || UTF) { - UV prevnatvalue = NATIVE_TO_UNI(prevvalue); - UV natvalue = NATIVE_TO_UNI(value); + const UV prevnatvalue = NATIVE_TO_UNI(prevvalue); + const UV natvalue = NATIVE_TO_UNI(value); ANYOF_FLAGS(ret) |= ANYOF_UNICODE; if (prevnatvalue < natvalue) { /* what about > ? */ @@ -4231,7 +4217,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) if (FOLD) { U8 foldbuf[UTF8_MAXBYTES_CASE+1]; STRLEN foldlen; - UV f = to_uni_fold(natvalue, foldbuf, &foldlen); + const UV f = to_uni_fold(natvalue, foldbuf, &foldlen); /* If folding and foldable and a single * character, insert also the folded version @@ -4380,10 +4366,9 @@ S_nextchar(pTHX_ RExC_state_t *pRExC_state) STATIC regnode * /* Location. */ S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op) { - register regnode *ret; register regnode *ptr; + regnode * const ret = RExC_emit; - ret = RExC_emit; if (SIZE_ONLY) { SIZE_ALIGN(RExC_size); RExC_size += 1; @@ -4416,10 +4401,9 @@ S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op) STATIC regnode * /* Location. */ S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg) { - register regnode *ret; register regnode *ptr; + regnode * const ret = RExC_emit; - ret = RExC_emit; if (SIZE_ONLY) { SIZE_ALIGN(RExC_size); RExC_size += 2; @@ -4451,7 +4435,7 @@ S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg) - reguni - emit (if appropriate) a Unicode character */ STATIC void -S_reguni(pTHX_ RExC_state_t *pRExC_state, UV uv, char* s, STRLEN* lenp) +S_reguni(pTHX_ const RExC_state_t *pRExC_state, UV uv, char* s, STRLEN* lenp) { *lenp = SIZE_ONLY ? UNISKIP(uv) : (uvchr_to_utf8((U8*)s, uv) - (U8*)s); } @@ -4467,7 +4451,7 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd) register regnode *src; register regnode *dst; register regnode *place; - register int offset = regarglen[(U8)op]; + const int offset = regarglen[(U8)op]; /* (PL_regkind[(U8)op] == CURLY ? EXTRA_STEP_2ARGS : 0); */ @@ -4523,7 +4507,6 @@ STATIC void S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p, regnode *val) { register regnode *scan; - register regnode *temp; if (SIZE_ONLY) return; @@ -4531,7 +4514,7 @@ S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p, regnode *val) /* Find last node. */ scan = p; for (;;) { - temp = regnext(scan); + regnode * const temp = regnext(scan); if (temp == NULL) break; scan = temp; @@ -4568,7 +4551,7 @@ S_regoptail(pTHX_ RExC_state_t *pRExC_state, regnode *p, regnode *val) - regcurly - a little FSA that accepts {\d+,?\d*} */ STATIC I32 -S_regcurly(pTHX_ register char *s) +S_regcurly(pTHX_ register const char *s) { if (*s++ != '{') return FALSE; @@ -4585,82 +4568,6 @@ S_regcurly(pTHX_ register char *s) return TRUE; } - -#ifdef DEBUGGING - -STATIC regnode * -S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l) -{ - register U8 op = EXACT; /* Arbitrary non-END op. */ - register regnode *next; - - while (op != END && (!last || node < last)) { - /* While that wasn't END last time... */ - - NODE_ALIGN(node); - op = OP(node); - if (op == CLOSE) - l--; - next = regnext(node); - /* Where, what. */ - if (OP(node) == OPTIMIZED) - goto after_print; - regprop(sv, node); - PerlIO_printf(Perl_debug_log, "%4"IVdf":%*s%s", (IV)(node - start), - (int)(2*l + 1), "", SvPVX(sv)); - if (next == NULL) /* Next ptr. */ - PerlIO_printf(Perl_debug_log, "(0)"); - else - PerlIO_printf(Perl_debug_log, "(%"IVdf")", (IV)(next - start)); - (void)PerlIO_putc(Perl_debug_log, '\n'); - after_print: - if (PL_regkind[(U8)op] == BRANCHJ) { - register regnode *nnode = (OP(next) == LONGJMP - ? regnext(next) - : next); - if (last && nnode > last) - nnode = last; - node = dumpuntil(start, NEXTOPER(NEXTOPER(node)), nnode, sv, l + 1); - } - else if (PL_regkind[(U8)op] == BRANCH) { - node = dumpuntil(start, NEXTOPER(node), next, sv, l + 1); - } - else if ( op == CURLY) { /* `next' might be very big: optimizer */ - node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS, - NEXTOPER(node) + EXTRA_STEP_2ARGS + 1, sv, l + 1); - } - else if (PL_regkind[(U8)op] == CURLY && op != CURLYX) { - node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS, - next, sv, l + 1); - } - else if ( op == PLUS || op == STAR) { - node = dumpuntil(start, NEXTOPER(node), NEXTOPER(node) + 1, sv, l + 1); - } - else if (op == ANYOF) { - /* arglen 1 + class block */ - node += 1 + ((ANYOF_FLAGS(node) & ANYOF_LARGE) - ? ANYOF_CLASS_SKIP : ANYOF_SKIP); - node = NEXTOPER(node); - } - else if (PL_regkind[(U8)op] == EXACT) { - /* Literal string, where present. */ - node += NODE_SZ_STR(node) - 1; - node = NEXTOPER(node); - } - else { - node = NEXTOPER(node); - node += regarglen[(U8)op]; - } - if (op == CURLYX || op == OPEN) - l++; - else if (op == WHILEM) - l--; - } - return node; -} - -#endif /* DEBUGGING */ - /* - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form */ @@ -4668,44 +4575,44 @@ void Perl_regdump(pTHX_ regexp *r) { #ifdef DEBUGGING - SV *sv = sv_newmortal(); + SV * const sv = sv_newmortal(); (void)dumpuntil(r->program, r->program + 1, NULL, sv, 0); /* Header fields of interest. */ if (r->anchored_substr) PerlIO_printf(Perl_debug_log, - "anchored `%s%.*s%s'%s at %"IVdf" ", + "anchored \"%s%.*s%s\"%s at %"IVdf" ", PL_colors[0], (int)(SvCUR(r->anchored_substr) - (SvTAIL(r->anchored_substr)!=0)), - SvPVX(r->anchored_substr), + SvPVX_const(r->anchored_substr), PL_colors[1], SvTAIL(r->anchored_substr) ? "$" : "", (IV)r->anchored_offset); else if (r->anchored_utf8) PerlIO_printf(Perl_debug_log, - "anchored utf8 `%s%.*s%s'%s at %"IVdf" ", + "anchored utf8 \"%s%.*s%s\"%s at %"IVdf" ", PL_colors[0], (int)(SvCUR(r->anchored_utf8) - (SvTAIL(r->anchored_utf8)!=0)), - SvPVX(r->anchored_utf8), + SvPVX_const(r->anchored_utf8), PL_colors[1], SvTAIL(r->anchored_utf8) ? "$" : "", (IV)r->anchored_offset); if (r->float_substr) PerlIO_printf(Perl_debug_log, - "floating `%s%.*s%s'%s at %"IVdf"..%"UVuf" ", + "floating \"%s%.*s%s\"%s at %"IVdf"..%"UVuf" ", PL_colors[0], (int)(SvCUR(r->float_substr) - (SvTAIL(r->float_substr)!=0)), - SvPVX(r->float_substr), + SvPVX_const(r->float_substr), PL_colors[1], SvTAIL(r->float_substr) ? "$" : "", (IV)r->float_min_offset, (UV)r->float_max_offset); else if (r->float_utf8) PerlIO_printf(Perl_debug_log, - "floating utf8 `%s%.*s%s'%s at %"IVdf"..%"UVuf" ", + "floating utf8 \"%s%.*s%s\"%s at %"IVdf"..%"UVuf" ", PL_colors[0], (int)(SvCUR(r->float_utf8) - (SvTAIL(r->float_utf8)!=0)), - SvPVX(r->float_utf8), + SvPVX_const(r->float_utf8), PL_colors[1], SvTAIL(r->float_utf8) ? "$" : "", (IV)r->float_min_offset, (UV)r->float_max_offset); @@ -4723,7 +4630,7 @@ Perl_regdump(pTHX_ regexp *r) if (r->regstclass) { regprop(sv, r->regstclass); - PerlIO_printf(Perl_debug_log, "stclass `%s' ", SvPVX(sv)); + PerlIO_printf(Perl_debug_log, "stclass \"%s\" ", SvPVX_const(sv)); } if (r->reganch & ROPT_ANCH) { PerlIO_printf(Perl_debug_log, "anchored"); @@ -4757,24 +4664,11 @@ Perl_regdump(pTHX_ regexp *r) (UV)r->offsets[i*2]); PerlIO_printf(Perl_debug_log, "\n"); } +#else + PERL_UNUSED_ARG(r); #endif /* DEBUGGING */ } -#ifdef DEBUGGING - -STATIC void -S_put_byte(pTHX_ SV *sv, int c) -{ - if (isCNTRL(c) || c == 255 || !isPRINT(c)) - Perl_sv_catpvf(aTHX_ sv, "\\%o", c); - else if (c == '-' || c == ']' || c == '\\' || c == '^') - Perl_sv_catpvf(aTHX_ sv, "\\%c", c); - else - Perl_sv_catpvf(aTHX_ sv, "%c", c); -} - -#endif /* DEBUGGING */ - /* - regprop - printable representation of opcode */ @@ -4794,12 +4688,12 @@ Perl_regprop(pTHX_ SV *sv, regnode *o) k = PL_regkind[(U8)OP(o)]; if (k == EXACT) { - SV *dsv = sv_2mortal(newSVpvn("", 0)); + SV * const dsv = sv_2mortal(newSVpvs("")); /* Using is_utf8_string() is a crude hack but it may * be the best for now since we have no flag "this EXACTish * node was UTF-8" --jhi */ - bool do_utf8 = is_utf8_string((U8*)STRING(o), STR_LEN(o)); - char *s = do_utf8 ? + const bool do_utf8 = is_utf8_string((U8*)STRING(o), STR_LEN(o)); + const char * const s = do_utf8 ? pv_uni_display(dsv, (U8*)STRING(o), STR_LEN(o), 60, UNI_DISPLAY_REGEX) : STRING(o); @@ -4824,9 +4718,10 @@ Perl_regprop(pTHX_ SV *sv, regnode *o) Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* 2: embedded, otherwise 1 */ else if (k == ANYOF) { int i, rangestart = -1; - U8 flags = ANYOF_FLAGS(o); - const char * const anyofs[] = { /* Should be synchronized with - * ANYOF_ #xdefines in regcomp.h */ + const U8 flags = ANYOF_FLAGS(o); + + /* Should be synchronized with * ANYOF_ #xdefines in regcomp.h */ + static const char * const anyofs[] = { "\\w", "\\W", "\\s", @@ -4860,12 +4755,12 @@ Perl_regprop(pTHX_ SV *sv, regnode *o) }; if (flags & ANYOF_LOCALE) - sv_catpv(sv, "{loc}"); + sv_catpvs(sv, "{loc}"); if (flags & ANYOF_FOLD) - sv_catpv(sv, "{i}"); + sv_catpvs(sv, "{i}"); Perl_sv_catpvf(aTHX_ sv, "[%s", PL_colors[0]); if (flags & ANYOF_INVERT) - sv_catpv(sv, "^"); + sv_catpvs(sv, "^"); for (i = 0; i <= 256; i++) { if (i < 256 && ANYOF_BITMAP_TEST(o,i)) { if (rangestart == -1) @@ -4876,7 +4771,7 @@ Perl_regprop(pTHX_ SV *sv, regnode *o) put_byte(sv, rangestart); else { put_byte(sv, rangestart); - sv_catpv(sv, "-"); + sv_catpvs(sv, "-"); put_byte(sv, i - 1); } rangestart = -1; @@ -4889,54 +4784,57 @@ Perl_regprop(pTHX_ SV *sv, regnode *o) sv_catpv(sv, anyofs[i]); if (flags & ANYOF_UNICODE) - sv_catpv(sv, "{unicode}"); + sv_catpvs(sv, "{unicode}"); else if (flags & ANYOF_UNICODE_ALL) - sv_catpv(sv, "{unicode_all}"); + sv_catpvs(sv, "{unicode_all}"); { SV *lv; - SV *sw = regclass_swash(o, FALSE, &lv, 0); + SV * const sw = regclass_swash(o, FALSE, &lv, 0); if (lv) { if (sw) { U8 s[UTF8_MAXBYTES_CASE+1]; for (i = 0; i <= 256; i++) { /* just the first 256 */ - U8 *e = uvchr_to_utf8(s, i); + uvchr_to_utf8(s, i); if (i < 256 && swash_fetch(sw, s, TRUE)) { if (rangestart == -1) rangestart = i; } else if (rangestart != -1) { - U8 *p; - if (i <= rangestart + 3) for (; rangestart < i; rangestart++) { - for(e = uvchr_to_utf8(s, rangestart), p = s; p < e; p++) + const U8 * const e = uvchr_to_utf8(s,rangestart); + U8 *p; + for(p = s; p < e; p++) put_byte(sv, *p); } else { - for (e = uvchr_to_utf8(s, rangestart), p = s; p < e; p++) + const U8 *e = uvchr_to_utf8(s,rangestart); + U8 *p; + for (p = s; p < e; p++) + put_byte(sv, *p); + sv_catpvs(sv, "-"); + e = uvchr_to_utf8(s, i-1); + for (p = s; p < e; p++) put_byte(sv, *p); - sv_catpv(sv, "-"); - for (e = uvchr_to_utf8(s, i - 1), p = s; p < e; p++) - put_byte(sv, *p); } rangestart = -1; } } - sv_catpv(sv, "..."); /* et cetera */ + sv_catpvs(sv, "..."); /* et cetera */ } { char *s = savesvpv(lv); - char *origs = s; + char * const origs = s; while(*s && *s != '\n') s++; if (*s == '\n') { - char *t = ++s; + const char * const t = ++s; while (*s) { if (*s == '\n') @@ -4958,6 +4856,9 @@ Perl_regprop(pTHX_ SV *sv, regnode *o) } else if (k == BRANCHJ && (OP(o) == UNLESSM || OP(o) == IFMATCH)) Perl_sv_catpvf(aTHX_ sv, "[-%d]", o->flags); +#else + PERL_UNUSED_ARG(sv); + PERL_UNUSED_ARG(o); #endif /* DEBUGGING */ } @@ -4965,13 +4866,13 @@ SV * Perl_re_intuit_string(pTHX_ regexp *prog) { /* Assume that RE_INTUIT is set */ DEBUG_r( - { STRLEN n_a; - char *s = SvPV(prog->check_substr - ? prog->check_substr : prog->check_utf8, n_a); + { + const char * const s = SvPV_nolen_const(prog->check_substr + ? prog->check_substr : prog->check_utf8); if (!PL_colorset) reginitcolors(); PerlIO_printf(Perl_debug_log, - "%sUsing REx %ssubstr:%s `%s%.60s%s%s'\n", + "%sUsing REx %ssubstr:%s \"%s%.60s%s%s\"\n", PL_colors[4], prog->check_substr ? "" : "utf8 ", PL_colors[5],PL_colors[0], @@ -4987,13 +4888,13 @@ void Perl_pregfree(pTHX_ struct regexp *r) { #ifdef DEBUGGING - SV *dsv = PERL_DEBUG_PAD_ZERO(0); + SV * const dsv = PERL_DEBUG_PAD_ZERO(0); #endif if (!r || (--r->refcnt > 0)) return; DEBUG_r({ - const char *s = (r->reganch & ROPT_UTF8) + const char * const s = (r->reganch & ROPT_UTF8) ? pv_uni_display(dsv, (U8*)r->precomp, r->prelen, 60, UNI_DISPLAY_REGEX) : pv_display(dsv, r->precomp, r->prelen, 0, 60); const int len = SvCUR(dsv); @@ -5007,10 +4908,10 @@ Perl_pregfree(pTHX_ struct regexp *r) len > 60 ? "..." : ""); }); - if (r->precomp) - Safefree(r->precomp); - if (r->offsets) /* 20010421 MJD */ - Safefree(r->offsets); + /* gcov results gave these as non-null 100% of the time, so there's no + optimisation in checking them before calling Safefree */ + Safefree(r->precomp); + Safefree(r->offsets); /* 20010421 MJD */ if (RX_MATCH_COPIED(r)) Safefree(r->subbeg); if (r->substrs) { @@ -5047,8 +4948,7 @@ Perl_pregfree(pTHX_ struct regexp *r) Perl_croak(aTHX_ "panic: pregfree comppad"); PAD_SAVE_LOCAL(old_comppad, /* Watch out for global destruction's random ordering. */ - (SvTYPE(new_comppad) == SVt_PVAV) ? - new_comppad : Null(PAD *) + (SvTYPE(new_comppad) == SVt_PVAV) ? new_comppad : NULL ); OP_REFCNT_LOCK; refcnt = OpREFCNT_dec((OP_4tree*)r->data->data[n]); @@ -5121,7 +5021,7 @@ S_re_croak2(pTHX_ const char* pat1,const char* pat2,...) #endif msv = vmess(buf, &args); va_end(args); - message = SvPV(msv,l1); + message = SvPV_const(msv,l1); if (l1 > 512) l1 = 512; Copy(message, buf, l1 , char); @@ -5134,71 +5034,83 @@ S_re_croak2(pTHX_ const char* pat1,const char* pat2,...) void Perl_save_re_context(pTHX) { - SAVEI32(PL_reg_flags); /* from regexec.c */ - SAVEPPTR(PL_bostr); - SAVEPPTR(PL_reginput); /* String-input pointer. */ - SAVEPPTR(PL_regbol); /* Beginning of input, for ^ check. */ - SAVEPPTR(PL_regeol); /* End of input, for $ check. */ - SAVEVPTR(PL_regstartp); /* Pointer to startp array. */ - SAVEVPTR(PL_regendp); /* Ditto for endp. */ - SAVEVPTR(PL_reglastparen); /* Similarly for lastparen. */ - SAVEVPTR(PL_reglastcloseparen); /* Similarly for lastcloseparen. */ - SAVEPPTR(PL_regtill); /* How far we are required to go. */ - SAVEGENERICPV(PL_reg_start_tmp); /* from regexec.c */ + + struct re_save_state *state; + + SAVEVPTR(PL_curcop); + SSGROW(SAVESTACK_ALLOC_FOR_RE_SAVE_STATE + 1); + + state = (struct re_save_state *)(PL_savestack + PL_savestack_ix); + PL_savestack_ix += SAVESTACK_ALLOC_FOR_RE_SAVE_STATE; + SSPUSHINT(SAVEt_RE_STATE); + + state->re_state_reg_flags = PL_reg_flags; + state->re_state_bostr = PL_bostr; + state->re_state_reginput = PL_reginput; + state->re_state_regbol = PL_regbol; + state->re_state_regeol = PL_regeol; + state->re_state_regstartp = PL_regstartp; + state->re_state_regendp = PL_regendp; + state->re_state_reglastparen = PL_reglastparen; + state->re_state_reglastcloseparen = PL_reglastcloseparen; + state->re_state_regtill = PL_regtill; + state->re_state_reg_start_tmp = PL_reg_start_tmp; + state->re_state_reg_start_tmpl = PL_reg_start_tmpl; + state->re_state_reg_eval_set = PL_reg_eval_set; + state->re_state_regnarrate = PL_regnarrate; + state->re_state_regindent = PL_regindent; + state->re_state_reg_call_cc = PL_reg_call_cc; + state->re_state_reg_re = PL_reg_re; + state->re_state_reg_ganch = PL_reg_ganch; + state->re_state_reg_sv = PL_reg_sv; + state->re_state_reg_match_utf8 = PL_reg_match_utf8; + state->re_state_reg_magic = PL_reg_magic; + state->re_state_reg_oldpos = PL_reg_oldpos; + state->re_state_reg_oldcurpm = PL_reg_oldcurpm; + state->re_state_reg_curpm = PL_reg_curpm; + state->re_state_reg_oldsaved = PL_reg_oldsaved; + state->re_state_reg_oldsavedlen = PL_reg_oldsavedlen; + state->re_state_reg_maxiter = PL_reg_maxiter; + state->re_state_reg_leftiter = PL_reg_leftiter; + state->re_state_reg_poscache = PL_reg_poscache; + state->re_state_reg_poscache_size = PL_reg_poscache_size; + state->re_state_regsize = PL_regsize; + state->re_state_reg_starttry = PL_reg_starttry; + + /* These variables have been eliminated from 5.10: */ + state->re_state_regdata = PL_regdata; + state->re_state_regprogram = PL_regprogram; + state->re_state_regcc = PL_regcc; + state->re_state_regprecomp = PL_regprecomp; + state->re_state_regnpar = PL_regnpar; + PL_reg_start_tmp = 0; - SAVEI32(PL_reg_start_tmpl); /* from regexec.c */ PL_reg_start_tmpl = 0; - SAVEVPTR(PL_regdata); - SAVEI32(PL_reg_eval_set); /* from regexec.c */ - SAVEI32(PL_regnarrate); /* from regexec.c */ - SAVEVPTR(PL_regprogram); /* from regexec.c */ - SAVEINT(PL_regindent); /* from regexec.c */ - SAVEVPTR(PL_regcc); /* from regexec.c */ - SAVEVPTR(PL_curcop); - SAVEVPTR(PL_reg_call_cc); /* from regexec.c */ - SAVEVPTR(PL_reg_re); /* from regexec.c */ - SAVEPPTR(PL_reg_ganch); /* from regexec.c */ - SAVESPTR(PL_reg_sv); /* from regexec.c */ - SAVEBOOL(PL_reg_match_utf8); /* from regexec.c */ - SAVEVPTR(PL_reg_magic); /* from regexec.c */ - SAVEI32(PL_reg_oldpos); /* from regexec.c */ - SAVEVPTR(PL_reg_oldcurpm); /* from regexec.c */ - SAVEVPTR(PL_reg_curpm); /* from regexec.c */ - SAVEPPTR(PL_reg_oldsaved); /* old saved substr during match */ - PL_reg_oldsaved = Nullch; - SAVEI32(PL_reg_oldsavedlen); /* old length of saved substr during match */ + PL_reg_oldsaved = NULL; PL_reg_oldsavedlen = 0; - SAVEI32(PL_reg_maxiter); /* max wait until caching pos */ PL_reg_maxiter = 0; - SAVEI32(PL_reg_leftiter); /* wait until caching pos */ PL_reg_leftiter = 0; - SAVEGENERICPV(PL_reg_poscache); /* cache of pos of WHILEM */ - PL_reg_poscache = Nullch; - SAVEI32(PL_reg_poscache_size); /* size of pos cache of WHILEM */ + PL_reg_poscache = NULL; PL_reg_poscache_size = 0; - SAVEPPTR(PL_regprecomp); /* uncompiled string. */ - SAVEI32(PL_regnpar); /* () count. */ - SAVEI32(PL_regsize); /* from regexec.c */ - { - /* Save $1..$n (#18107: UTF-8 s/(\w+)/uc($1)/e); AMS 20021106. */ - U32 i; - GV *mgv; - REGEXP *rx; - char digits[TYPE_CHARS(long)]; - - if (PL_curpm && (rx = PM_GETRE(PL_curpm))) { + /* Save $1..$n (#18107: UTF-8 s/(\w+)/uc($1)/e); AMS 20021106. */ + if (PL_curpm) { + const REGEXP * const rx = PM_GETRE(PL_curpm); + if (rx) { + U32 i; for (i = 1; i <= rx->nparens; i++) { - sprintf(digits, "%lu", (long)i); - if ((mgv = gv_fetchpv(digits, FALSE, SVt_PV))) + char digits[TYPE_CHARS(long)]; +#ifdef USE_SNPRINTF + const STRLEN len = snprintf(digits, sizeof(digits), "%lu", (long)i); +#else + const STRLEN len = my_sprintf(digits, "%lu", (long)i); +#endif /* #ifdef USE_SNPRINTF */ + GV * const mgv = gv_fetchpvn_flags(digits, len, 0, SVt_PV); + if (mgv) save_scalar(mgv); } } } - -#ifdef DEBUGGING - SAVEPPTR(PL_reg_starttry); /* from regexec.c */ -#endif } static void @@ -5207,6 +5119,93 @@ clear_re(pTHX_ void *r) ReREFCNT_dec((regexp *)r); } +#ifdef DEBUGGING + +STATIC void +S_put_byte(pTHX_ SV *sv, int c) +{ + if (isCNTRL(c) || c == 255 || !isPRINT(c)) + Perl_sv_catpvf(aTHX_ sv, "\\%o", c); + else if (c == '-' || c == ']' || c == '\\' || c == '^') + Perl_sv_catpvf(aTHX_ sv, "\\%c", c); + else + Perl_sv_catpvf(aTHX_ sv, "%c", c); +} + + +STATIC regnode * +S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l) +{ + register U8 op = EXACT; /* Arbitrary non-END op. */ + register regnode *next; + + while (op != END && (!last || node < last)) { + /* While that wasn't END last time... */ + + NODE_ALIGN(node); + op = OP(node); + if (op == CLOSE) + l--; + next = regnext(node); + /* Where, what. */ + if (OP(node) == OPTIMIZED) + goto after_print; + regprop(sv, node); + PerlIO_printf(Perl_debug_log, "%4"IVdf":%*s%s", (IV)(node - start), + (int)(2*l + 1), "", SvPVX_const(sv)); + if (next == NULL) /* Next ptr. */ + PerlIO_printf(Perl_debug_log, "(0)"); + else + PerlIO_printf(Perl_debug_log, "(%"IVdf")", (IV)(next - start)); + (void)PerlIO_putc(Perl_debug_log, '\n'); + after_print: + if (PL_regkind[(U8)op] == BRANCHJ) { + register regnode *nnode = (OP(next) == LONGJMP + ? regnext(next) + : next); + if (last && nnode > last) + nnode = last; + node = dumpuntil(start, NEXTOPER(NEXTOPER(node)), nnode, sv, l + 1); + } + else if (PL_regkind[(U8)op] == BRANCH) { + node = dumpuntil(start, NEXTOPER(node), next, sv, l + 1); + } + else if ( op == CURLY) { /* "next" might be very big: optimizer */ + node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS, + NEXTOPER(node) + EXTRA_STEP_2ARGS + 1, sv, l + 1); + } + else if (PL_regkind[(U8)op] == CURLY && op != CURLYX) { + node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS, + next, sv, l + 1); + } + else if ( op == PLUS || op == STAR) { + node = dumpuntil(start, NEXTOPER(node), NEXTOPER(node) + 1, sv, l + 1); + } + else if (op == ANYOF) { + /* arglen 1 + class block */ + node += 1 + ((ANYOF_FLAGS(node) & ANYOF_LARGE) + ? ANYOF_CLASS_SKIP : ANYOF_SKIP); + node = NEXTOPER(node); + } + else if (PL_regkind[(U8)op] == EXACT) { + /* Literal string, where present. */ + node += NODE_SZ_STR(node) - 1; + node = NEXTOPER(node); + } + else { + node = NEXTOPER(node); + node += regarglen[(U8)op]; + } + if (op == CURLYX || op == OPEN) + l++; + else if (op == WHILEM) + l--; + } + return node; +} + +#endif /* DEBUGGING */ + /* * Local variables: * c-indentation-style: bsd @@ -5214,5 +5213,5 @@ clear_re(pTHX_ void *r) * indent-tabs-mode: t * End: * - * vim: shiftwidth=4: -*/ + * ex: set ts=8 sts=4 sw=4 noet: + */