From: Yves Orton Date: Fri, 7 Jul 2006 10:40:40 +0000 (+0200) Subject: More escaping in the RE X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0df25f3d8d51b9b8c7ab6750af674952bc4bb6c2;p=p5sagit%2Fp5-mst-13.2.git More escaping in the RE Message-ID: <9b18b3110607070140p5cb2c58ftcadbcd113a58c3af@mail.gmail.com> (with tweaks) p4raw-id: //depot/perl@28500 --- diff --git a/regcomp.c b/regcomp.c index 4de5727..10c6682 100644 --- a/regcomp.c +++ b/regcomp.c @@ -6423,13 +6423,8 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o) * 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 * const s = do_utf8 ? - pv_uni_display(dsv, (U8*)STRING(o), STR_LEN(o), 60, - UNI_DISPLAY_REGEX) : - STRING(o); - const int len = do_utf8 ? - strlen(s) : - STR_LEN(o); + RE_PV_DISPLAY_DECL(s, len, do_utf8, dsv, STRING(o), STR_LEN(o), 60); + Perl_sv_catpvf(aTHX_ sv, " <%s%.*s%s>", PL_colors[0], len, s, @@ -6628,26 +6623,25 @@ void Perl_pregfree(pTHX_ struct regexp *r) { dVAR; -#ifdef DEBUGGING - SV * const dsv = PERL_DEBUG_PAD_ZERO(0); -#endif + + + GET_RE_DEBUG_FLAGS_DECL; if (!r || (--r->refcnt > 0)) return; DEBUG_COMPILE_r(if (RX_DEBUG(r)){ - 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); - if (!PL_colorset) - reginitcolors(); - PerlIO_printf(Perl_debug_log, - "%sFreeing REx:%s %s%*.*s%s%s\n", - PL_colors[4],PL_colors[5],PL_colors[0], - len, len, s, - PL_colors[1], - len > 60 ? "..." : ""); + RE_PV_DISPLAY_DECL(s, len, (r->reganch & ROPT_UTF8), + PERL_DEBUG_PAD_ZERO(0), r->precomp, r->prelen, 60); + + if (!PL_colorset) + reginitcolors(); + PerlIO_printf(Perl_debug_log, + "%sFreeing REx:%s %s%*.*s%s%s\n", + PL_colors[4],PL_colors[5],PL_colors[0], + len, len, s, + PL_colors[1], + len > 60 ? "..." : ""); }); /* gcov results gave these as non-null 100% of the time, so there's no diff --git a/regcomp.h b/regcomp.h index b1f953e..535897f 100644 --- a/regcomp.h +++ b/regcomp.h @@ -624,7 +624,13 @@ re.pm, especially to the documentation. #ifdef DEBUGGING #define GET_RE_DEBUG_FLAGS_DECL IV re_debug_flags = 0; GET_RE_DEBUG_FLAGS; +#define RE_PV_DISPLAY_DECL(rpv,rlen,isuni,dsv,pv,l,m) \ + const char * const rpv = (isuni) ? \ + pv_uni_display(dsv, (U8*)(pv), l, m, UNI_DISPLAY_REGEX) : \ + pv_escape(dsv, pv, l, m, 0); \ + const int rlen = SvCUR(dsv) #else #define GET_RE_DEBUG_FLAGS_DECL +#define RE_PV_DISPLAY_DECL #endif diff --git a/regexec.c b/regexec.c index 53b9ff7..99eb074 100644 --- a/regexec.c +++ b/regexec.c @@ -358,7 +358,6 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, const I32 multiline = prog->reganch & PMf_MULTILINE; #ifdef DEBUGGING const char * const i_strpos = strpos; - SV * const dsv = PERL_DEBUG_PAD_ZERO(0); #endif GET_RE_DEBUG_FLAGS_DECL; @@ -372,11 +371,9 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, } DEBUG_EXECUTE_r({ - const char *s = PL_reg_match_utf8 ? - sv_uni_display(dsv, sv, 60, UNI_DISPLAY_REGEX) : - strpos; - const int len = PL_reg_match_utf8 ? - (int)strlen(s) : strend - strpos; + RE_PV_DISPLAY_DECL(s, len, PL_reg_match_utf8, + PERL_DEBUG_PAD_ZERO(0), strpos, strend - strpos, 60); + if (!PL_colorset) reginitcolors(); if (PL_reg_match_utf8) @@ -1772,10 +1769,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * SV* const oreplsv = GvSV(PL_replgv); const bool do_utf8 = DO_UTF8(sv); I32 multiline; -#ifdef DEBUGGING - SV* dsv0; - SV* dsv1; -#endif + regmatch_info reginfo; /* create some info to pass to regtry etc */ GET_RE_DEBUG_FLAGS_DECL; @@ -1791,11 +1785,6 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * multiline = prog->reganch & PMf_MULTILINE; reginfo.prog = prog; -#ifdef DEBUGGING - dsv0 = PERL_DEBUG_PAD_ZERO(0); - dsv1 = PERL_DEBUG_PAD_ZERO(1); -#endif - RX_MATCH_UTF8_set(prog, do_utf8); minlen = prog->minlen; @@ -1864,14 +1853,11 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * } DEBUG_EXECUTE_r({ - const char * const s0 = UTF - ? pv_uni_display(dsv0, (U8*)prog->precomp, prog->prelen, 60, - UNI_DISPLAY_REGEX) - : prog->precomp; - const int len0 = UTF ? (int)SvCUR(dsv0) : prog->prelen; - const char * const s1 = do_utf8 ? sv_uni_display(dsv1, sv, 60, - UNI_DISPLAY_REGEX) : startpos; - const int len1 = do_utf8 ? (int)SvCUR(dsv1) : strend - startpos; + RE_PV_DISPLAY_DECL(s0, len0, UTF, + PERL_DEBUG_PAD_ZERO(0), prog->precomp, prog->prelen, 60); + RE_PV_DISPLAY_DECL(s1, len1, do_utf8, + PERL_DEBUG_PAD_ZERO(1), startpos, strend - startpos, 60); + if (!PL_colorset) reginitcolors(); PerlIO_printf(Perl_debug_log, @@ -2076,24 +2062,17 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * } DEBUG_EXECUTE_r({ SV * const prop = sv_newmortal(); - const char *s0; - const char *s1; - int len0; - int len1; - regprop(prog, prop, c); - s0 = UTF ? - pv_uni_display(dsv0, (U8*)SvPVX_const(prop), SvCUR(prop), 60, - UNI_DISPLAY_REGEX) : - SvPVX_const(prop); - len0 = UTF ? SvCUR(dsv0) : SvCUR(prop); - s1 = UTF ? - sv_uni_display(dsv1, sv, 60, UNI_DISPLAY_REGEX) : s; - len1 = UTF ? (int)SvCUR(dsv1) : strend - s; - PerlIO_printf(Perl_debug_log, - "Matching stclass \"%*.*s\" against \"%*.*s\" (%d chars)\n", - len0, len0, s0, - len1, len1, s1, (int)(strend - s)); + { + RE_PV_DISPLAY_DECL(s0,len0,UTF, + PERL_DEBUG_PAD_ZERO(0),SvPVX_const(prop),SvCUR(prop),60); + RE_PV_DISPLAY_DECL(s1,len1,UTF, + PERL_DEBUG_PAD_ZERO(1),s,strend-s,60); + PerlIO_printf(Perl_debug_log, + "Matching stclass \"%*.*s\" against \"%*.*s\" (%d chars)\n", + len0, len0, s0, + len1, len1, s1, (int)(strend - s)); + } }); if (find_byclass(prog, c, s, strend, ®info)) goto got_it; @@ -2648,28 +2627,17 @@ S_dump_exec_pos(pTHX_ const char *locinput, const regnode *scan, const bool do_u pref0_len = pref_len; { const int is_uni = (do_utf8 && OP(scan) != CANY) ? 1 : 0; - const char * const s0 = is_uni ? - pv_uni_display(PERL_DEBUG_PAD(0), (U8*)(locinput - pref_len), - pref0_len, 60, UNI_DISPLAY_REGEX) : - pv_escape(PERL_DEBUG_PAD(0), (locinput - pref_len), - pref0_len, 60, 0); - - const int len0 = strlen(s0); - const char * const s1 = is_uni ? - pv_uni_display(PERL_DEBUG_PAD(1), - (U8*)(locinput - pref_len + pref0_len), - pref_len - pref0_len, 60, UNI_DISPLAY_REGEX) : - pv_escape(PERL_DEBUG_PAD(1), + + RE_PV_DISPLAY_DECL(s0,len0,is_uni,PERL_DEBUG_PAD(0), + (locinput - pref_len),pref0_len, 60); + + RE_PV_DISPLAY_DECL(s1,len1,is_uni,PERL_DEBUG_PAD(1), (locinput - pref_len + pref0_len), - pref_len - pref0_len, 60, 0); - - const int len1 = (int)strlen(s1); - const char * const s2 = is_uni ? - pv_uni_display(PERL_DEBUG_PAD(2), (U8*)locinput, - PL_regeol - locinput, 60, UNI_DISPLAY_REGEX) : - pv_escape(PERL_DEBUG_PAD(2), locinput, - PL_regeol - locinput, 60, 0); - const int len2 = (int)strlen(s2); + pref_len - pref0_len, 60); + + RE_PV_DISPLAY_DECL(s2,len2,is_uni,PERL_DEBUG_PAD(2), + locinput, PL_regeol - locinput, 60); + PerlIO_printf(Perl_debug_log, "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|", (IV)(locinput - PL_bostr),