X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=regcomp.c;h=d86083160ae886957399ce95a6b513f750bf527e;hb=9da9462bb3e8caa6ed89b73deed69ec85fa59066;hp=b35dcf94f8907791a9fd1cf15a336c12b2e34bf8;hpb=f8c7b90fa8a3676239aeea262e148f9a4e497558;p=p5sagit%2Fp5-mst-13.2.git diff --git a/regcomp.c b/regcomp.c index b35dcf9..d860831 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 * @@ -307,7 +306,7 @@ static const scan_data_t zero_scan_data = * 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 +324,7 @@ static const scan_data_t zero_scan_data = * 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 +343,7 @@ static const scan_data_t zero_scan_data = * 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 +361,19 @@ static const scan_data_t zero_scan_data = * 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 +381,25 @@ static const scan_data_t zero_scan_data = #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 +425,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); \ } \ @@ -450,9 +439,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); \ } \ @@ -507,8 +496,8 @@ 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) mg->mg_len = 0; @@ -530,7 +519,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 +556,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 +592,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 @@ -776,7 +765,7 @@ and would end up looking like: DEBUG_TRIE_COMPILE_r({ \ SV *tmp; \ if ( UTF ) { \ - tmp = newSVpv( "", 0 ); \ + tmp = newSVpvn( "", 0 ); \ pv_uni_display( tmp, uc, len, 60, UNI_DISPLAY_REGEX ); \ } else { \ tmp = Perl_newSVpvf_nocontext( "%c", (int)uvc ); \ @@ -825,7 +814,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; \ @@ -857,10 +846,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(); @@ -899,7 +888,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 ); const U8 *uc = (U8*)STRING( noper ); - const U8 *e = uc + STR_LEN( noper ); + const U8 * const e = uc + STR_LEN( noper ); STRLEN foldlen = 0; U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ]; const U8 *scan = (U8*)NULL; @@ -979,7 +968,7 @@ 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; @@ -987,7 +976,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs regnode *noper = NEXTOPER( cur ); U8 *uc = (U8*)STRING( noper ); - U8 *e = uc + STR_LEN( 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 */ @@ -1024,14 +1013,13 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs newstate = TRIE_LIST_ITEM( state, check ).newstate; break; } - } - if ( ! newstate ) { - newstate = next_alloc++; - TRIE_LIST_PUSH( state, charid, newstate ); - transcount++; - } - state = newstate; - + } + 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 ); } @@ -1060,16 +1048,14 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs DEBUG_TRIE_COMPILE_MORE_r({ U32 state; - U16 charid; - /* - print out the table precompression. - */ + /* print out the table precompression. */ PerlIO_printf( Perl_debug_log, "\nState :Word | Transition Data\n" ); PerlIO_printf( Perl_debug_log, "------:-----+-----------------" ); for( state=1 ; state < next_alloc ; state ++ ) { + U16 charid; PerlIO_printf( Perl_debug_log, "\n %04"UVXf" :", (UV)state ); if ( ! trie->states[ state ].wordnum ) { @@ -1082,7 +1068,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) { SV **tmp = av_fetch( trie->revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0); PerlIO_printf( Perl_debug_log, "%s:%3X=%04"UVXf" | ", - SvPV_nolen( *tmp ), + SvPV_nolen_const( *tmp ), TRIE_LIST_ITEM(state,charid).forid, (UV)TRIE_LIST_ITEM(state,charid).newstate ); @@ -1092,10 +1078,9 @@ 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; - U16 idx; U32 tp = 0; U32 zp = 0; @@ -1112,7 +1097,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs if (trie->states[state].trans.list) { U16 minid=TRIE_LIST_ITEM( state, 1).forid; U16 maxid=minid; - + U16 idx; for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) { if ( TRIE_LIST_ITEM( state, idx).forid < minid ) { @@ -1200,16 +1185,16 @@ 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 ); - U8 *uc = (U8*)STRING( noper ); - U8 *e = uc + STR_LEN( noper ); + const U8 *uc = (U8*)STRING( noper ); + const U8 * const e = uc + STR_LEN( noper ); U32 state = 1; /* required init */ @@ -1280,7 +1265,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) { SV **tmp = av_fetch( trie->revcharmap, charid, 0); if ( tmp ) { - PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen( *tmp ) ); + PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen_const( *tmp ) ); } } @@ -1371,15 +1356,15 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs demq */ const U32 laststate = TRIE_NODENUM( next_alloc ); - U32 used , state, charid; + U32 state, charid; U32 pos = 0, zp=0; trie->laststate = laststate; for ( state = 1 ; state < laststate ; state++ ) { U8 flag = 0; - U32 stateidx = TRIE_NODEIDX( state ); - U32 o_used=trie->trans[ stateidx ].check; - used = trie->trans[ stateidx ].check; + const U32 stateidx = TRIE_NODEIDX( state ); + const U32 o_used = trie->trans[ stateidx ].check; + U32 used = trie->trans[ stateidx ].check; trie->trans[ stateidx ].check = 0; for ( charid = 0 ; used && charid < trie->uniquecharcount ; charid++ ) { @@ -1437,7 +1422,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs for( state = 0 ; state < trie->uniquecharcount ; state++ ) { SV **tmp = av_fetch( trie->revcharmap, state, 0); if ( tmp ) { - PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen( *tmp ) ); + PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen_const( *tmp ) ); } } PerlIO_printf( Perl_debug_log, "\n-----:-----------------------"); @@ -1447,7 +1432,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs PerlIO_printf( Perl_debug_log, "\n"); for( state = 1 ; state < trie->laststate ; state++ ) { - U32 base = trie->states[ state ].trans.base; + const U32 base = trie->states[ state ].trans.base; PerlIO_printf( Perl_debug_log, "#%04"UVXf" ", (UV)state); @@ -1555,7 +1540,8 @@ 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. */ @@ -1578,7 +1564,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg SV *mysv=sv_newmortal(); regprop( mysv, scan); PerlIO_printf(Perl_debug_log, "%*speep: %s (0x%08"UVXf")\n", - (int)depth*2, "", SvPV_nolen(mysv), PTR2UV(scan)); + (int)depth*2, "", SvPV_nolen_const(mysv), PTR2UV(scan)); }); if (PL_regkind[(U8)OP(scan)] == EXACT) { @@ -1656,8 +1642,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg */ 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; + 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)); @@ -1872,7 +1858,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg DEBUG_OPTIMISE_r({ regprop( mysv, tail ); PerlIO_printf( Perl_debug_log, "%*s%s%s%s\n", - (int)depth * 2 + 2, "", "Tail node is:", SvPV_nolen( mysv ), + (int)depth * 2 + 2, "", "Tail node is:", SvPV_nolen_const( mysv ), (RExC_seen_evals) ? "[EVAL]" : "" ); }); @@ -1903,22 +1889,22 @@ 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); PerlIO_printf( Perl_debug_log, "%*s%s", - (int)depth * 2 + 2," ", SvPV_nolen( mysv ) ); + (int)depth * 2 + 2," ", SvPV_nolen_const( mysv ) ); regprop( mysv, noper); PerlIO_printf( Perl_debug_log, " -> %s", - SvPV_nolen(mysv)); + SvPV_nolen_const(mysv)); if ( noper_next ) { regprop( mysv, noper_next ); PerlIO_printf( Perl_debug_log,"\t=> %s\t", - SvPV_nolen(mysv)); + SvPV_nolen_const(mysv)); } PerlIO_printf( Perl_debug_log, "0x%p,0x%p,0x%p)\n", first, last, cur ); @@ -1936,20 +1922,20 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg if (!last ) { regprop( mysv, first); PerlIO_printf( Perl_debug_log, "%*s%s", - (int)depth * 2 + 2, "F:", SvPV_nolen( mysv ) ); + (int)depth * 2 + 2, "F:", SvPV_nolen_const( mysv ) ); regprop( mysv, NEXTOPER(first) ); PerlIO_printf( Perl_debug_log, " -> %s\n", - SvPV_nolen( mysv ) ); + SvPV_nolen_const( mysv ) ); } ); last = cur; DEBUG_OPTIMISE_r({ regprop( mysv, cur); PerlIO_printf( Perl_debug_log, "%*s%s", - (int)depth * 2 + 2, "N:", SvPV_nolen( mysv ) ); + (int)depth * 2 + 2, "N:", SvPV_nolen_const( mysv ) ); regprop( mysv, noper ); PerlIO_printf( Perl_debug_log, " -> %s\n", - SvPV_nolen( mysv ) ); + SvPV_nolen_const( mysv ) ); }); } } else { @@ -1978,7 +1964,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg regprop( mysv, cur); PerlIO_printf( Perl_debug_log, "%*s%s\t(0x%p,0x%p,0x%p)\n", (int)depth * 2 + 2, - " ", SvPV_nolen( mysv ), first, last, cur); + " ", SvPV_nolen_const( mysv ), first, last, cur); }); if ( last ) { @@ -2016,8 +2002,8 @@ 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; - 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), @@ -2217,12 +2203,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"); @@ -2355,7 +2341,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg #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) @@ -2364,14 +2350,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 @@ -2703,7 +2689,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) @@ -2772,9 +2758,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); @@ -2887,7 +2873,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"); @@ -2910,7 +2896,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) 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; } @@ -2949,7 +2935,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... */ @@ -3128,7 +3114,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], @@ -3184,7 +3170,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], @@ -3208,8 +3194,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); @@ -3246,7 +3232,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) wasted_c = 0x04; char * parse_start = RExC_parse; /* MJD */ - char *oregcomp_parse = RExC_parse; + char * const oregcomp_parse = RExC_parse; char c; *flagp = 0; /* Tentatively. */ @@ -3258,7 +3244,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) U32 posflags = 0, negflags = 0; U32 *flagsp = &posflags; int logical = 0; - char *seqstart = RExC_parse; + const char * const seqstart = RExC_parse; RExC_parse++; paren = *RExC_parse++; @@ -3853,7 +3839,7 @@ 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, @@ -4290,7 +4276,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; } @@ -4474,7 +4460,6 @@ S_regwhite(pTHX_ char *p, const 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 && @@ -4490,6 +4475,7 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value) RExC_parse = s; else { const char* t = RExC_parse++; /* skip over the c */ + const char *posixcc; assert(*t == c); @@ -4833,7 +4819,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); @@ -5539,7 +5525,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); } @@ -5673,119 +5659,6 @@ S_regcurly(pTHX_ register const char *s) } -#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_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 ( PL_regkind[(U8)op] == TRIE ) { - const I32 n = ARG(node); - const reg_trie_data *trie = (reg_trie_data*)PL_regdata->data[n]; - const I32 arry_len = av_len(trie->words)+1; - I32 word_idx; - PerlIO_printf(Perl_debug_log, - "%*s[Words:%d Chars Stored:%d Unique Chars:%d States:%"IVdf"%s]\n", - (int)(2*(l+3)), - "", - trie->wordcount, - (int)trie->charcount, - trie->uniquecharcount, - (IV)trie->laststate-1, - node->flags ? " EVAL mode" : ""); - - for (word_idx=0; word_idx < arry_len; word_idx++) { - SV **elem_ptr=av_fetch(trie->words,word_idx,0); - if (elem_ptr) { - PerlIO_printf(Perl_debug_log, "%*s<%s%s%s>\n", - (int)(2*(l+4)), "", - PL_colors[0], - SvPV_nolen(*elem_ptr), - PL_colors[1] - ); - /* - if (next == NULL) - PerlIO_printf(Perl_debug_log, "(0)\n"); - else - PerlIO_printf(Perl_debug_log, "(%"IVdf")\n", (IV)(next - start)); - */ - } - - } - - node = NEXTOPER(node); - node += regarglen[(U8)op]; - - } - 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 */ @@ -5887,22 +5760,6 @@ Perl_regdump(pTHX_ regexp *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 */ @@ -5922,12 +5779,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(newSVpvn("", 0)); /* 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); @@ -5962,7 +5819,7 @@ 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 U8 flags = ANYOF_FLAGS(o); const char * const anyofs[] = { /* Should be synchronized with * ANYOF_ #xdefines in regcomp.h */ "\\w", @@ -6033,7 +5890,7 @@ Perl_regprop(pTHX_ SV *sv, const regnode *o) { SV *lv; - SV *sw = regclass_swash(o, FALSE, &lv, 0); + SV * const sw = regclass_swash(o, FALSE, &lv, 0); if (lv) { if (sw) { @@ -6046,20 +5903,21 @@ 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_catpvn(sv, "-", 1); + e = uvchr_to_utf8(s, i-1); + for (p = s; p < e; p++) put_byte(sv, *p); } rangestart = -1; @@ -6076,7 +5934,7 @@ Perl_regprop(pTHX_ SV *sv, const regnode *o) while(*s && *s != '\n') s++; if (*s == '\n') { - const char *t = ++s; + const char * const t = ++s; while (*s) { if (*s == '\n') @@ -6106,9 +5964,9 @@ Perl_re_intuit_string(pTHX_ regexp *prog) { /* Assume that RE_INTUIT is set */ GET_RE_DEBUG_FLAGS_DECL; DEBUG_COMPILE_r( - { STRLEN n_a; - const 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, @@ -6151,10 +6009,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 */ RX_MATCH_COPY_FREE(r); #ifdef PERL_OLD_COPY_ON_WRITE if (r->saved_copy) @@ -6214,17 +6072,14 @@ Perl_pregfree(pTHX_ struct regexp *r) reg_trie_data *trie=(reg_trie_data*)r->data->data[n]; U32 refcount; OP_REFCNT_LOCK; - refcount = trie->refcount--; + refcount = --trie->refcount; OP_REFCNT_UNLOCK; if ( !refcount ) { - if (trie->charmap) - Safefree(trie->charmap); + Safefree(trie->charmap); if (trie->widecharmap) SvREFCNT_dec((SV*)trie->widecharmap); - if (trie->states) - Safefree(trie->states); - if (trie->trans) - Safefree(trie->trans); + Safefree(trie->states); + Safefree(trie->trans); #ifdef DEBUGGING if (trie->words) SvREFCNT_dec((SV*)trie->words); @@ -6291,7 +6146,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); @@ -6381,6 +6236,131 @@ 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 ( PL_regkind[(U8)op] == TRIE ) { + const I32 n = ARG(node); + const reg_trie_data * const trie = (reg_trie_data*)PL_regdata->data[n]; + const I32 arry_len = av_len(trie->words)+1; + I32 word_idx; + PerlIO_printf(Perl_debug_log, + "%*s[Words:%d Chars Stored:%d Unique Chars:%d States:%"IVdf"%s]\n", + (int)(2*(l+3)), + "", + trie->wordcount, + (int)trie->charcount, + trie->uniquecharcount, + (IV)trie->laststate-1, + node->flags ? " EVAL mode" : ""); + + for (word_idx=0; word_idx < arry_len; word_idx++) { + SV **elem_ptr=av_fetch(trie->words,word_idx,0); + if (elem_ptr) { + PerlIO_printf(Perl_debug_log, "%*s<%s%s%s>\n", + (int)(2*(l+4)), "", + PL_colors[0], + SvPV_nolen_const(*elem_ptr), + PL_colors[1] + ); + /* + if (next == NULL) + PerlIO_printf(Perl_debug_log, "(0)\n"); + else + PerlIO_printf(Perl_debug_log, "(%"IVdf")\n", (IV)(next - start)); + */ + } + + } + + node = NEXTOPER(node); + node += regarglen[(U8)op]; + + } + 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