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.

diff --git a/intrpvar.h b/intrpvar.h
index 6bfbc4d..87f33d8 100644 (file)
--- 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 c3a0824..94e1eb5 100644 (file)
--- 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 bb746b7..8c42d4e 100644 (file)
--- 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 81daff6..a19ede9 100644 (file)
--- 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);