In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/eecd4d1156438b131ac47c72b020788f66b6d178?hp=5cde1e48fc4b594cb096ce7f78f6757d53d4f19a>
- Log ----------------------------------------------------------------- commit eecd4d1156438b131ac47c72b020788f66b6d178 Author: Karl Williamson <[email protected]> Date: Fri Oct 27 12:28:57 2017 -0600 Change upper limit handling of -Dr output Commit 2bfbbbaf9ef1783ba914ff9e9270e877fbbb6aba changed things so -Dr output could be changed through an environment variable to truncate the output differently than the default. For most purposes, the default is good enough, but for someone trying to debug the regcomp internals, sometimes one wants to see more than is output by default. That commit did not catch all the places. This one changes the handling so that any place that use the previous default maximum now uses the environment variable (if set) instead. ----------------------------------------------------------------------- Summary of changes: intrpvar.h | 2 +- regcomp.c | 17 +++++++++-------- regcomp.h | 27 ++++++++++++--------------- regexec.c | 10 +++++----- 4 files changed, 27 insertions(+), 29 deletions(-) diff --git a/intrpvar.h b/intrpvar.h index 6bfbc4d831..87f33d8bb4 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -828,7 +828,7 @@ PERLVARA(I, op_exec_cnt, OP_max+2, UV) /* Counts of executed OPs of the given ty PERLVAR(I, random_state, PL_RANDOM_STATE_TYPE) -PERLVARI(I, dump_re_max_len, STRLEN, 0) +PERLVARI(I, dump_re_max_len, STRLEN, 60) /* For internal uses of randomness, this ensures the sequence of * random numbers returned by rand() isn't modified by perl's internal diff --git a/regcomp.c b/regcomp.c index c3a082488c..94e1eb5ecb 100644 --- a/regcomp.c +++ b/regcomp.c @@ -6907,7 +6907,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, if ( ! dump_len_string || ! grok_atoUV(dump_len_string, (UV *)&PL_dump_re_max_len, NULL)) { - PL_dump_re_max_len = 0; + PL_dump_re_max_len = 60; /* A reasonable default */ } #endif } @@ -7036,7 +7036,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, }); DEBUG_COMPILE_r({ SV *dsv= sv_newmortal(); - RE_PV_QUOTED_DECL(s, RExC_utf8, dsv, exp, plen, 60); + RE_PV_QUOTED_DECL(s, RExC_utf8, dsv, exp, plen, PL_dump_re_max_len); Perl_re_printf( aTHX_ "%sCompiling REx%s %s\n", PL_colors[4],PL_colors[5],s); }); @@ -18981,7 +18981,7 @@ Perl_regdump(pTHX_ const regexp *r) RE_PV_QUOTED_DECL(s, 0, dsv, SvPVX_const(r->substrs->data[i].substr), RE_SV_DUMPLEN(r->substrs->data[i].substr), - 30); + PL_dump_re_max_len); Perl_re_printf( aTHX_ "%s %s%s at %" IVdf "..%" UVuf " ", i ? "floating" : "anchored", @@ -19131,7 +19131,8 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ * is a crude hack but it may be the best for now since * we have no flag "this EXACTish node was UTF-8" * --jhi */ - pv_pretty(sv, STRING(o), STR_LEN(o), 60, PL_colors[0], PL_colors[1], + pv_pretty(sv, STRING(o), STR_LEN(o), PL_dump_re_max_len, + PL_colors[0], PL_colors[1], PERL_PV_ESCAPE_UNI_DETECT | PERL_PV_ESCAPE_NONASCII | PERL_PV_PRETTY_ELLIPSES | @@ -19355,7 +19356,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ SV* contents; /* See if truncation size is overridden */ - const STRLEN dump_len = (PL_dump_re_max_len) + const STRLEN dump_len = (PL_dump_re_max_len > 256) ? PL_dump_re_max_len : 256; @@ -19482,7 +19483,7 @@ Perl_re_intuit_string(pTHX_ REGEXP * const r) PL_colors[5],PL_colors[0], s, PL_colors[1], - (strlen(s) > 60 ? "..." : "")); + (strlen(s) > PL_dump_re_max_len ? "..." : "")); } ); /* use UTF8 check substring if regexp pattern itself is in UTF8 */ @@ -19667,7 +19668,7 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx) { SV *dsv= sv_newmortal(); RE_PV_QUOTED_DECL(s, RX_UTF8(rx), - dsv, RX_PRECOMP(rx), RX_PRELEN(rx), 60); + dsv, RX_PRECOMP(rx), RX_PRELEN(rx), PL_dump_re_max_len); Perl_re_printf( aTHX_ "%sFreeing REx:%s %s\n", PL_colors[4],PL_colors[5],s); } @@ -20798,7 +20799,7 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, indent+3, elem_ptr ? pv_pretty(sv, SvPV_nolen_const(*elem_ptr), - SvCUR(*elem_ptr), 60, + SvCUR(*elem_ptr), PL_dump_re_max_len, PL_colors[0], PL_colors[1], (SvUTF8(*elem_ptr) ? PERL_PV_ESCAPE_UNI diff --git a/regcomp.h b/regcomp.h index bb746b7334..8c42d4e76d 100644 --- a/regcomp.h +++ b/regcomp.h @@ -1066,26 +1066,23 @@ re.pm, especially to the documentation. #define GET_RE_DEBUG_FLAGS_DECL volatile IV re_debug_flags = 0; \ PERL_UNUSED_VAR(re_debug_flags); GET_RE_DEBUG_FLAGS; -#define RE_PV_COLOR_DECL(rpv,rlen,isuni,dsv,pv,l,m,c1,c2) \ - const char * const rpv = \ - pv_pretty((dsv), (pv), (l), \ - (PL_dump_re_max_len) ? PL_dump_re_max_len : (m), \ - PL_colors[(c1)],PL_colors[(c2)], \ +#define RE_PV_COLOR_DECL(rpv,rlen,isuni,dsv,pv,l,m,c1,c2) \ + const char * const rpv = \ + pv_pretty((dsv), (pv), (l), (m), \ + PL_colors[(c1)],PL_colors[(c2)], \ PERL_PV_ESCAPE_RE|PERL_PV_ESCAPE_NONASCII |((isuni) ? PERL_PV_ESCAPE_UNI : 0) ); \ const int rlen = SvCUR(dsv) -#define RE_SV_ESCAPE(rpv,isuni,dsv,sv,m) \ - const char * const rpv = \ - pv_pretty((dsv), (SvPV_nolen_const(sv)), (SvCUR(sv)), \ - (PL_dump_re_max_len) ? PL_dump_re_max_len : (m), \ - PL_colors[(c1)],PL_colors[(c2)], \ +#define RE_SV_ESCAPE(rpv,isuni,dsv,sv,m) \ + const char * const rpv = \ + pv_pretty((dsv), (SvPV_nolen_const(sv)), (SvCUR(sv)), (m), \ + PL_colors[(c1)],PL_colors[(c2)], \ PERL_PV_ESCAPE_RE|PERL_PV_ESCAPE_NONASCII |((isuni) ? PERL_PV_ESCAPE_UNI : 0) ) -#define RE_PV_QUOTED_DECL(rpv,isuni,dsv,pv,l,m) \ - const char * const rpv = \ - pv_pretty((dsv), (pv), (l), \ - (PL_dump_re_max_len) ? PL_dump_re_max_len : (m), \ - PL_colors[0], PL_colors[1], \ +#define RE_PV_QUOTED_DECL(rpv,isuni,dsv,pv,l,m) \ + const char * const rpv = \ + pv_pretty((dsv), (pv), (l), (m), \ + PL_colors[0], PL_colors[1], \ ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_ESCAPE_NONASCII | PERL_PV_PRETTY_ELLIPSES | \ ((isuni) ? PERL_PV_ESCAPE_UNI : 0)) \ ) diff --git a/regexec.c b/regexec.c index 81daff60fd..a19ede95dc 100644 --- a/regexec.c +++ b/regexec.c @@ -3379,7 +3379,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, regprop(prog, prop, c, reginfo, NULL); { RE_PV_QUOTED_DECL(quoted,utf8_target,PERL_DEBUG_PAD_ZERO(1), - s,strend-s,60); + s,strend-s,PL_dump_re_max_len); Perl_re_printf( aTHX_ "Matching stclass %.*s against %s (%d bytes)\n", (int)SvCUR(prop), SvPVX_const(prop), @@ -3899,10 +3899,10 @@ S_debug_start_match(pTHX_ const REGEXP *prog, const bool utf8_target, reginitcolors(); { RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0), - RX_PRECOMP_const(prog), RX_PRELEN(prog), 60); + RX_PRECOMP_const(prog), RX_PRELEN(prog), PL_dump_re_max_len); RE_PV_QUOTED_DECL(s1, utf8_target, PERL_DEBUG_PAD_ZERO(1), - start, end - start, 60); + start, end - start, PL_dump_re_max_len); Perl_re_printf( aTHX_ "%s%s REx%s %s against %s\n", @@ -3958,11 +3958,11 @@ S_dump_exec_pos(pTHX_ const char *locinput, const int is_uni = utf8_target ? 1 : 0; RE_PV_COLOR_DECL(s0,len0,is_uni,PERL_DEBUG_PAD(0), - (locinput - pref_len),pref0_len, 60, 4, 5); + (locinput - pref_len),pref0_len, PL_dump_re_max_len, 4, 5); RE_PV_COLOR_DECL(s1,len1,is_uni,PERL_DEBUG_PAD(1), (locinput - pref_len + pref0_len), - pref_len - pref0_len, 60, 2, 3); + pref_len - pref0_len, PL_dump_re_max_len, 2, 3); RE_PV_COLOR_DECL(s2,len2,is_uni,PERL_DEBUG_PAD(2), locinput, loc_regeol - locinput, 10, 0, 1); -- Perl5 Master Repository
