Skip to content

Commit

Permalink
Change upper limit handling of -Dr output
Browse files Browse the repository at this point in the history 
Commit 2bfbbba 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.
  • Loading branch information
@khwilliamson
khwilliamson committed Oct 27, 2017
1 parent 5cde1e4 commit eecd4d1
Show file tree
Hide file tree
Showing 4 changed files with 27 additions and 29 deletions.
2 changes: 1 addition & 1 deletion intrpvar.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
17 changes: 9 additions & 8 deletions regcomp.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
}
Expand Down Expand Up @@ -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);
});
Expand Down Expand Up @@ -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",
Expand Down Expand Up @@ -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 |
Expand Down Expand Up @@ -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;

Expand Down Expand Up @@ -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 */
Expand Down Expand Up @@ -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);
}
Expand Down Expand Up @@ -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
Expand Down
27 changes: 12 additions & 15 deletions regcomp.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)) \
)
Expand Down
10 changes: 5 additions & 5 deletions regexec.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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),
Expand Down Expand Up @@ -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",
Expand Down Expand Up @@ -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);
Expand Down

0 comments on commit eecd4d1

Please sign in to comment.