X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/43c5f42db1e336a99904bcc798b7070727bfbd0a..a91233bf4cf6a12df8935c3530a6ca900ca6ca2f:/regcomp.c diff --git a/regcomp.c b/regcomp.c index 57f5834..b3c31b7 100644 --- a/regcomp.c +++ b/regcomp.c @@ -79,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. @@ -282,27 +282,6 @@ static const scan_data_t zero_scan_data = } 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 { \ @@ -425,7 +404,7 @@ static const scan_data_t zero_scan_data = 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); \ } \ @@ -439,9 +418,9 @@ static const scan_data_t zero_scan_data = #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); \ } \ @@ -508,7 +487,7 @@ S_scan_commit(pTHX_ RExC_state_t *pRExC_state, scan_data_t *data) /* Can match anything (initialization) */ STATIC void -S_cl_anything(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl) +S_cl_anything(RExC_state_t *pRExC_state, struct regnode_charclass_class *cl) { ANYOF_CLASS_ZERO(cl); ANYOF_BITMAP_SETALL(cl); @@ -519,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_ const struct regnode_charclass_class *cl) +S_cl_is_anything(const struct regnode_charclass_class *cl) { int value; @@ -535,7 +514,7 @@ S_cl_is_anything(pTHX_ const struct regnode_charclass_class *cl) /* Can match anything (initialization) */ STATIC void -S_cl_init(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl) +S_cl_init(RExC_state_t *pRExC_state, struct regnode_charclass_class *cl) { Zero(cl, 1, struct regnode_charclass_class); cl->type = ANYOF; @@ -543,7 +522,7 @@ S_cl_init(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl) } STATIC void -S_cl_init_zero(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl) +S_cl_init_zero(RExC_state_t *pRExC_state, struct regnode_charclass_class *cl) { Zero(cl, 1, struct regnode_charclass_class); cl->type = ANYOF; @@ -555,7 +534,7 @@ S_cl_init_zero(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class * /* 'And' a given class with another one. Can create false positives */ /* We assume that cl is not inverted */ STATIC void -S_cl_and(pTHX_ struct regnode_charclass_class *cl, +S_cl_and(struct regnode_charclass_class *cl, const struct regnode_charclass_class *and_with) { if (!(and_with->flags & ANYOF_CLASS) @@ -592,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, const struct regnode_charclass_class *or_with) +S_cl_or(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 @@ -765,7 +744,7 @@ and would end up looking like: DEBUG_TRIE_COMPILE_r({ \ SV *tmp; \ if ( UTF ) { \ - tmp = newSVpvn( "", 0 ); \ + tmp = newSVpvs( "" ); \ pv_uni_display( tmp, uc, len, 60, UNI_DISPLAY_REGEX ); \ } else { \ tmp = Perl_newSVpvf_nocontext( "%c", (int)uvc ); \ @@ -814,7 +793,7 @@ and would end up looking like: } STMT_END #define TRIE_LIST_NEW(state) STMT_START { \ - Newz( 1023, trie->states[ state ].trans.list, \ + Newxz( trie->states[ state ].trans.list, \ 4, reg_trie_trans_le ); \ TRIE_LIST_CUR( state ) = 1; \ TRIE_LIST_LEN( state ) = 4; \ @@ -846,10 +825,10 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs GET_RE_DEBUG_FLAGS_DECL; - Newz( 848200, trie, 1, reg_trie_data ); + Newxz( trie, 1, reg_trie_data ); trie->refcount = 1; RExC_rx->data->data[ data_slot ] = (void*)trie; - Newz( 848201, trie->charmap, 256, U16 ); + Newxz( trie->charmap, 256, U16 ); DEBUG_r({ trie->words = newAV(); trie->revcharmap = newAV(); @@ -886,7 +865,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs for ( cur = first ; cur < last ; cur = regnext( cur ) ) { - regnode *noper = NEXTOPER( cur ); + regnode * const noper = NEXTOPER( cur ); const U8 *uc = (U8*)STRING( noper ); const U8 * const e = uc + STR_LEN( noper ); STRLEN foldlen = 0; @@ -968,78 +947,76 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs STRLEN transcount = 1; - Newz( 848204, trie->states, trie->charcount + 2, reg_trie_state ); + Newxz( trie->states, trie->charcount + 2, reg_trie_state ); TRIE_LIST_NEW(1); next_alloc = 2; for ( cur = first ; cur < last ; cur = regnext( cur ) ) { - regnode *noper = NEXTOPER( cur ); - U8 *uc = (U8*)STRING( noper ); - const U8 * const e = uc + STR_LEN( noper ); - U32 state = 1; /* required init */ - U16 charid = 0; /* sanity init */ - U8 *scan = (U8*)NULL; /* sanity init */ - STRLEN foldlen = 0; /* required init */ - U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ]; - - - for ( ; uc < e ; uc += len ) { - - TRIE_READ_CHAR; - - if ( uvc < 256 ) { - charid = trie->charmap[ uvc ]; - } else { - SV** svpp=(SV**)NULL; - svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 0); - if ( !svpp ) { - charid = 0; - } else { - charid=(U16)SvIV( *svpp ); - } - } - if ( charid ) { + regnode * const noper = NEXTOPER( cur ); + U8 *uc = (U8*)STRING( noper ); + const U8 * const e = uc + STR_LEN( noper ); + U32 state = 1; /* required init */ + U16 charid = 0; /* sanity init */ + U8 *scan = (U8*)NULL; /* sanity init */ + STRLEN foldlen = 0; /* required init */ + U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ]; + + for ( ; uc < e ; uc += len ) { + + TRIE_READ_CHAR; + + if ( uvc < 256 ) { + charid = trie->charmap[ uvc ]; + } else { + SV** const svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 0); + if ( !svpp ) { + charid = 0; + } else { + charid=(U16)SvIV( *svpp ); + } + } + if ( charid ) { - U16 check; - U32 newstate = 0; + U16 check; + U32 newstate = 0; - charid--; - if ( !trie->states[ state ].trans.list ) { - TRIE_LIST_NEW( state ); - } - for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) { - if ( TRIE_LIST_ITEM( state, check ).forid == charid ) { - newstate = TRIE_LIST_ITEM( state, check ).newstate; - break; - } - } - if ( ! newstate ) { - newstate = next_alloc++; - TRIE_LIST_PUSH( state, charid, newstate ); - transcount++; + charid--; + if ( !trie->states[ state ].trans.list ) { + TRIE_LIST_NEW( state ); + } + for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) { + if ( TRIE_LIST_ITEM( state, check ).forid == charid ) { + newstate = TRIE_LIST_ITEM( state, check ).newstate; + break; + } + } + if ( ! newstate ) { + newstate = next_alloc++; + TRIE_LIST_PUSH( state, charid, newstate ); + transcount++; + } + state = newstate; + } else { + Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc ); } - state = newstate; - } else { - Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc ); - } - /* charid is now 0 if we dont know the char read, or nonzero if we do */ - } + /* charid is now 0 if we dont know the char read, or nonzero if we do */ + } - if ( !trie->states[ state ].wordnum ) { - /* we havent inserted this word into the structure yet. */ - trie->states[ state ].wordnum = ++curword; + if ( !trie->states[ state ].wordnum ) { + /* we havent inserted this word into the structure yet. */ + trie->states[ state ].wordnum = ++curword; - DEBUG_r({ - /* store the word for dumping */ - SV* tmp = newSVpvn( STRING( noper ), STR_LEN( noper ) ); - if ( UTF ) SvUTF8_on( tmp ); - av_push( trie->words, tmp ); - }); + DEBUG_r({ + /* store the word for dumping */ + SV* tmp = newSVpvn( STRING( noper ), STR_LEN( noper ) ); + if ( UTF ) SvUTF8_on( tmp ); + av_push( trie->words, tmp ); + }); - } else { - /* Its a dupe. So ignore it. */ - } + } else { + /*EMPTY*/; /* It's a dupe. So ignore it. */ + } } /* end second pass */ @@ -1078,7 +1055,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs PerlIO_printf( Perl_debug_log, "\n\n" ); }); - Newz( 848203, trie->trans, transcount ,reg_trie_trans ); + Newxz( trie->trans, transcount ,reg_trie_trans ); { U32 state; U32 tp = 0; @@ -1100,11 +1077,12 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs U16 idx; for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) { - if ( TRIE_LIST_ITEM( state, idx).forid < minid ) { - minid=TRIE_LIST_ITEM( state, idx).forid; - } else if ( TRIE_LIST_ITEM( state, idx).forid > maxid ) { - maxid=TRIE_LIST_ITEM( state, idx).forid; - } + const U16 forid = TRIE_LIST_ITEM( state, idx).forid; + if ( forid < minid ) { + minid=forid; + } else if ( forid > maxid ) { + maxid=forid; + } } if ( transcount < tp + maxid - minid + 1) { transcount *= 2; @@ -1131,7 +1109,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs } } else { for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) { - U32 tid = base - trie->uniquecharcount + TRIE_LIST_ITEM( state, idx ).forid; + const U32 tid = base - trie->uniquecharcount + TRIE_LIST_ITEM( state, idx ).forid; trie->trans[ tid ].next = TRIE_LIST_ITEM( state, idx ).newstate; trie->trans[ tid ].check = state; } @@ -1185,14 +1163,14 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs */ - Newz( 848203, trie->trans, ( trie->charcount + 1 ) * trie->uniquecharcount + 1, + Newxz( trie->trans, ( trie->charcount + 1 ) * trie->uniquecharcount + 1, reg_trie_trans ); - Newz( 848204, trie->states, trie->charcount + 2, reg_trie_state ); + Newxz( trie->states, trie->charcount + 2, reg_trie_state ); next_alloc = trie->uniquecharcount + 1; for ( cur = first ; cur < last ; cur = regnext( cur ) ) { - regnode *noper = NEXTOPER( cur ); + regnode * const noper = NEXTOPER( cur ); const U8 *uc = (U8*)STRING( noper ); const U8 * const e = uc + STR_LEN( noper ); @@ -1213,13 +1191,8 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs if ( uvc < 256 ) { charid = trie->charmap[ uvc ]; } else { - SV** svpp=(SV**)NULL; - svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 0); - if ( !svpp ) { - charid = 0; - } else { - charid=(U16)SvIV( *svpp ); - } + SV* const * const svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 0); + charid = svpp ? (U16)SvIV(*svpp) : 0; } if ( charid ) { charid--; @@ -1248,7 +1221,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs }); } else { - /* Its a dupe. So ignore it. */ + /*EMPTY*/; /* Its a dupe. So ignore it. */ } } /* end second pass */ @@ -1540,11 +1513,13 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs STATIC I32 -S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 flags, U32 depth) +S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, + regnode *last, scan_data_t *data, U32 flags, U32 depth) /* scanp: Start here (read-write). */ /* deltap: Write maxlen-minlen here. */ /* last: Stop before this one. */ { + dVAR; I32 min = 0, pars = 0, code; regnode *scan = *scanp, *next; I32 delta = 0; @@ -1560,7 +1535,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg while (scan && OP(scan) != END && scan < last) { /* Peephole optimizer: */ DEBUG_OPTIMISE_r({ - SV *mysv=sv_newmortal(); + SV * const mysv=sv_newmortal(); regprop( mysv, scan); PerlIO_printf(Perl_debug_log, "%*speep: %s (0x%08"UVXf")\n", (int)depth*2, "", SvPV_nolen_const(mysv), PTR2UV(scan)); @@ -1594,7 +1569,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg } else if (stringok) { const int oldl = STR_LEN(scan); - regnode *nnext = regnext(n); + regnode * const nnext = regnext(n); if (oldl + STR_LEN(n) > U8_MAX) break; @@ -1639,8 +1614,9 @@ 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; + 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; @@ -1839,7 +1815,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg U32 count=0; #ifdef DEBUGGING - SV *mysv = sv_newmortal(); /* for dumping */ + SV * const mysv = sv_newmortal(); /* for dumping */ #endif /* var tail is used because there may be a TAIL regop in the way. Ie, the exacts will point to the @@ -1888,8 +1864,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg /* dont use tail as the end marker for this traverse */ for ( cur = startbranch ; cur != scan ; cur = regnext( cur ) ) { - regnode *noper = NEXTOPER( cur ); - regnode *noper_next = regnext( noper ); + regnode * const noper = NEXTOPER( cur ); + regnode * const noper_next = regnext( noper ); DEBUG_OPTIMISE_r({ regprop( mysv, cur); @@ -1984,11 +1960,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) { const U8 * const s = (U8*)STRING(scan); l = utf8_length(s, s + l); uc = utf8_to_uvchr(s, NULL); + } else { + uc = *((U8*)STRING(scan)); } min += l; if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */ @@ -2001,7 +1979,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg } sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan)); { - SV * sv = data->last_found; + 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) @@ -2052,7 +2030,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); + const U8 * const s = (U8 *)STRING(scan); l = utf8_length(s, s + l); uc = utf8_to_uvchr(s, NULL); } @@ -2202,12 +2180,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"); @@ -2333,7 +2311,7 @@ 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. */ @@ -2747,7 +2725,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg } STATIC I32 -S_add_data(pTHX_ RExC_state_t *pRExC_state, I32 n, const char *s) +S_add_data(RExC_state_t *pRExC_state, I32 n, const char *s) { if (RExC_rx->data) { Renewc(RExC_rx->data, @@ -2757,9 +2735,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); @@ -2769,6 +2747,7 @@ S_add_data(pTHX_ RExC_state_t *pRExC_state, I32 n, const char *s) void Perl_reginitcolors(pTHX) { + dVAR; const char * const s = PerlEnv_getenv("PERL_RE_COLORS"); if (s) { char *t = savepv(s); @@ -2810,6 +2789,7 @@ Perl_reginitcolors(pTHX) regexp * Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) { + dVAR; register regexp *r; regnode *scan; regnode *first; @@ -2857,7 +2837,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_COMPILE_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" ", (IV)RExC_size)); @@ -2872,7 +2852,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"); @@ -2886,16 +2866,17 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) r->precomp = savepvn(RExC_precomp, r->prelen); r->subbeg = NULL; #ifdef PERL_OLD_COPY_ON_WRITE - r->saved_copy = Nullsv; + r->saved_copy = NULL; #endif 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; } @@ -2934,7 +2915,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... */ @@ -2965,7 +2946,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) again: if (PL_regkind[(U8)OP(first)] == EXACT) { if (OP(first) == EXACT) - ; /* Empty, get anchored substr later. */ + /*EMPTY*/; /* Empty, get anchored substr later. */ else if ((OP(first) == EXACTF || OP(first) == EXACTFL)) r->regstclass = first; } @@ -3022,9 +3003,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) { @@ -3059,10 +3040,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; @@ -3073,7 +3054,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; } @@ -3087,10 +3068,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 */ @@ -3099,7 +3080,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; } @@ -3113,7 +3094,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) { 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], @@ -3163,13 +3144,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,0); 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)) { 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], @@ -3193,8 +3174,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_COMPILE_r(regdump(r)); return(r); @@ -3217,22 +3198,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 * const oregcomp_parse = RExC_parse; - char c; *flagp = 0; /* Tentatively. */ @@ -3242,7 +3225,7 @@ 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; + bool is_logical = 0; const char * const seqstart = RExC_parse; RExC_parse++; @@ -3279,7 +3262,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++; @@ -3289,32 +3272,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); @@ -3343,7 +3322,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; @@ -3373,6 +3352,7 @@ 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)) @@ -3430,7 +3410,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( @@ -3446,8 +3426,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", @@ -3490,7 +3470,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 */ @@ -3519,7 +3499,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 */ @@ -3626,6 +3606,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) STATIC regnode * S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first) { + dVAR; register regnode *ret; register regnode *chain = NULL; register regnode *latest; @@ -3693,6 +3674,7 @@ S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first) STATIC regnode * S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) { + dVAR; register regnode *ret; register char op; register char *next; @@ -3715,7 +3697,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) @@ -3838,10 +3820,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); } @@ -3870,7 +3852,8 @@ 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; + dVAR; + register regnode *ret = NULL; I32 flags; char *parse_start = RExC_parse; @@ -4275,7 +4258,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; } @@ -4430,7 +4413,7 @@ tryagain: } STATIC char * -S_regwhite(pTHX_ char *p, const char *e) +S_regwhite(char *p, const char *e) { while (p < e) { if (isSPACE(*p)) @@ -4459,6 +4442,7 @@ S_regwhite(pTHX_ char *p, const char *e) STATIC I32 S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value) { + dVAR; I32 namedclass = OOB_NAMEDCLASS; if (value == '[' && RExC_parse + 1 < RExC_end && @@ -4618,6 +4602,7 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value) STATIC void S_checkposixcc(pTHX_ RExC_state_t *pRExC_state) { + dVAR; if (!SIZE_ONLY && POSIXCC(UCHARAT(RExC_parse))) { const char *s = RExC_parse; const char c = *s++; @@ -4645,6 +4630,7 @@ S_checkposixcc(pTHX_ RExC_state_t *pRExC_state) STATIC regnode * S_regclass(pTHX_ RExC_state_t *pRExC_state) { + dVAR; register UV value; register UV nextvalue; register IV prevvalue = OOB_UNICODE; @@ -4652,13 +4638,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 @@ -4684,7 +4670,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; @@ -4818,7 +4804,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); @@ -4840,12 +4826,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, '-'); @@ -5249,12 +5239,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 @@ -5455,6 +5449,7 @@ S_nextchar(pTHX_ RExC_state_t *pRExC_state) STATIC regnode * /* Location. */ S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op) { + dVAR; register regnode *ptr; regnode * const ret = RExC_emit; @@ -5490,6 +5485,7 @@ 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) { + dVAR; register regnode *ptr; regnode * const ret = RExC_emit; @@ -5526,6 +5522,7 @@ S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg) STATIC void S_reguni(pTHX_ const RExC_state_t *pRExC_state, UV uv, char* s, STRLEN* lenp) { + dVAR; *lenp = SIZE_ONLY ? UNISKIP(uv) : (uvchr_to_utf8((U8*)s, uv) - (U8*)s); } @@ -5537,6 +5534,7 @@ S_reguni(pTHX_ const RExC_state_t *pRExC_state, UV uv, char* s, STRLEN* lenp) STATIC void S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd) { + dVAR; register regnode *src; register regnode *dst; register regnode *place; @@ -5595,6 +5593,7 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd) STATIC void S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p, regnode *val) { + dVAR; register regnode *scan; if (SIZE_ONLY) @@ -5623,6 +5622,7 @@ S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p, regnode *val) STATIC void S_regoptail(pTHX_ RExC_state_t *pRExC_state, regnode *p, regnode *val) { + dVAR; /* "Operandless" and "op != BRANCH" are synonymous in practice. */ if (p == NULL || SIZE_ONLY) return; @@ -5640,7 +5640,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 const char *s) +S_regcurly(register const char *s) { if (*s++ != '{') return FALSE; @@ -5665,7 +5665,8 @@ void Perl_regdump(pTHX_ regexp *r) { #ifdef DEBUGGING - SV *sv = sv_newmortal(); + dVAR; + SV * const sv = sv_newmortal(); (void)dumpuntil(r->program, r->program + 1, NULL, sv, 0); @@ -5756,6 +5757,9 @@ Perl_regdump(pTHX_ regexp *r) PerlIO_printf(Perl_debug_log, "\n"); }); } +#else + PERL_UNUSED_CONTEXT; + PERL_UNUSED_ARG(r); #endif /* DEBUGGING */ } @@ -5766,6 +5770,7 @@ void Perl_regprop(pTHX_ SV *sv, const regnode *o) { #ifdef DEBUGGING + dVAR; register int k; sv_setpvn(sv, "", 0); @@ -5778,12 +5783,12 @@ Perl_regprop(pTHX_ SV *sv, const 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 */ const bool do_utf8 = is_utf8_string((U8*)STRING(o), STR_LEN(o)); - const char *s = do_utf8 ? + const char * const s = do_utf8 ? pv_uni_display(dsv, (U8*)STRING(o), STR_LEN(o), 60, UNI_DISPLAY_REGEX) : STRING(o); @@ -5794,7 +5799,9 @@ Perl_regprop(pTHX_ SV *sv, const regnode *o) PL_colors[0], len, s, PL_colors[1]); - } else if (k == TRIE) {/* + } else if (k == TRIE) { + /*EMPTY*/; + /* this isn't always safe, as Pl_regdata may not be for this regex yet (depending on where its called from) so its being moved to dumpuntil I32 n = ARG(o); @@ -5818,9 +5825,10 @@ Perl_regprop(pTHX_ SV *sv, const 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", @@ -5854,12 +5862,12 @@ Perl_regprop(pTHX_ SV *sv, const 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) @@ -5870,7 +5878,7 @@ Perl_regprop(pTHX_ SV *sv, const regnode *o) put_byte(sv, rangestart); else { put_byte(sv, rangestart); - sv_catpv(sv, "-"); + sv_catpvs(sv, "-"); put_byte(sv, i - 1); } rangestart = -1; @@ -5883,13 +5891,13 @@ Perl_regprop(pTHX_ SV *sv, const 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) { @@ -5902,37 +5910,38 @@ Perl_regprop(pTHX_ SV *sv, const regnode *o) if (rangestart == -1) rangestart = i; } else if (rangestart != -1) { - U8 *p; - if (i <= rangestart + 3) for (; rangestart < i; rangestart++) { - U8 *e; - 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 { - U8 *e; - 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_catpv(sv, "-"); - for (e = uvchr_to_utf8(s, i - 1), p = s; p < e; p++) + sv_catpvs(sv, "-"); + e = uvchr_to_utf8(s, i-1); + for (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') { - const char *t = ++s; + const char * const t = ++s; while (*s) { if (*s == '\n') @@ -5954,16 +5963,23 @@ Perl_regprop(pTHX_ SV *sv, const regnode *o) } else if (k == BRANCHJ && (OP(o) == UNLESSM || OP(o) == IFMATCH)) Perl_sv_catpvf(aTHX_ sv, "[-%d]", o->flags); +#else + PERL_UNUSED_CONTEXT; + PERL_UNUSED_ARG(sv); + PERL_UNUSED_ARG(o); #endif /* DEBUGGING */ } SV * Perl_re_intuit_string(pTHX_ regexp *prog) { /* Assume that RE_INTUIT is set */ + dVAR; GET_RE_DEBUG_FLAGS_DECL; + PERL_UNUSED_CONTEXT; + DEBUG_COMPILE_r( { - const char *s = SvPV_nolen_const(prog->check_substr + const char * const s = SvPV_nolen_const(prog->check_substr ? prog->check_substr : prog->check_utf8); if (!PL_colorset) reginitcolors(); @@ -5985,15 +6001,15 @@ Perl_pregfree(pTHX_ struct regexp *r) { dVAR; #ifdef DEBUGGING - SV *dsv = PERL_DEBUG_PAD_ZERO(0); - SV *re_debug_flags=get_sv(RE_DEBUG_FLAGS,0); + SV * const dsv = PERL_DEBUG_PAD_ZERO(0); + SV * const re_debug_flags=get_sv(RE_DEBUG_FLAGS,0); #endif if (!r || (--r->refcnt > 0)) return; DEBUG_r(if (re_debug_flags && (SvIV(re_debug_flags) & RE_DEBUG_COMPILE)) { - 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); @@ -6050,8 +6066,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]); @@ -6067,10 +6082,10 @@ Perl_pregfree(pTHX_ struct regexp *r) break; case 't': { - reg_trie_data *trie=(reg_trie_data*)r->data->data[n]; + reg_trie_data * const trie=(reg_trie_data*)r->data->data[n]; U32 refcount; OP_REFCNT_LOCK; - refcount = trie->refcount--; + refcount = --trie->refcount; OP_REFCNT_UNLOCK; if ( !refcount ) { Safefree(trie->charmap); @@ -6106,6 +6121,7 @@ Perl_pregfree(pTHX_ struct regexp *r) regnode * Perl_regnext(pTHX_ register regnode *p) { + dVAR; register I32 offset; if (p == &PL_regdummy) @@ -6157,6 +6173,7 @@ S_re_croak2(pTHX_ const char* pat1,const char* pat2,...) void Perl_save_re_context(pTHX) { + dVAR; SAVEI32(PL_reg_flags); /* from regexec.c */ SAVEPPTR(PL_bostr); SAVEPPTR(PL_reginput); /* String-input pointer. */ @@ -6188,37 +6205,41 @@ Perl_save_re_context(pTHX) 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; + PL_reg_oldsaved = NULL; SAVEI32(PL_reg_oldsavedlen); /* old length of saved substr during match */ PL_reg_oldsavedlen = 0; #ifdef PERL_OLD_COPY_ON_WRITE SAVESPTR(PL_nrs); - PL_nrs = Nullsv; + PL_nrs = NULL; #endif 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; + PL_reg_poscache = NULL; SAVEI32(PL_reg_poscache_size); /* size of pos cache of WHILEM */ 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. */ - REGEXP *rx; - - 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++) { - GV *mgv; char digits[TYPE_CHARS(long)]; - sprintf(digits, "%lu", (long)i); - if ((mgv = gv_fetchpv(digits, FALSE, SVt_PV))) - save_scalar(mgv); + const STRLEN len = my_sprintf(digits, "%lu", (long)i); + GV *const *const gvp + = (GV**)hv_fetch(PL_defstash, digits, len, 0); + + if (gvp) { + GV * const gv = *gvp; + if (SvTYPE(gv) == SVt_PVGV && GvSV(gv)) + save_scalar(gv); + } } } } @@ -6231,6 +6252,7 @@ Perl_save_re_context(pTHX) static void clear_re(pTHX_ void *r) { + dVAR; ReREFCNT_dec((regexp *)r); } @@ -6251,6 +6273,7 @@ S_put_byte(pTHX_ SV *sv, int c) STATIC regnode * S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l) { + dVAR; register U8 op = EXACT; /* Arbitrary non-END op. */ register regnode *next;