Dump Unicode better for re 'debug'. The regprop()

is unfinished since have to figure out how to detect
Unicodeness in there.

p4raw-id: //depot/perl@12621

diff --git a/regcomp.c b/regcomp.c
index a223533..928ffb4 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -4409,9 +4409,19 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
 
     k = PL_regkind[(U8)OP(o)];
 
-    if (k == EXACT)
-       Perl_sv_catpvf(aTHX_ sv, " <%s%.*s%s>", PL_colors[0],
-                      STR_LEN(o), STRING(o), PL_colors[1]);
+    if (k == EXACT) {
+        SV *dsv = sv_2mortal(newSVpvn("", 0));
+       char *s    = 0 ?
+         pv_uni_display(dsv, (U8*)STRING(o), STR_LEN(o), 60, 0) :
+         STRING(o);
+       STRLEN len = 0 ?
+         strlen(s) :
+         STR_LEN(o);
+       Perl_sv_catpvf(aTHX_ sv, " <%s%.*s%s>",
+                      PL_colors[0],
+                      len, s,
+                      PL_colors[1]);
+    }
     else if (k == CURLY) {
        if (OP(o) == CURLYM || OP(o) == CURLYN || OP(o) == CURLYX)
            Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* Parenth number */
@@ -4492,7 +4502,7 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
        if (flags & ANYOF_UNICODE)
            sv_catpv(sv, "{unicode}");
        else if (flags & ANYOF_UNICODE_ALL)
-           sv_catpv(sv, "{all-unicode}");
+           sv_catpv(sv, "{unicode_all}");
 
        {
            SV *lv;

diff --git a/regexec.c b/regexec.c
index d65d70c..09478bb 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -383,20 +383,26 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
     char *check_at = Nullch;           /* check substr found at this pos */
 #ifdef DEBUGGING
     char *i_strpos = strpos;
+    SV *dsv = sv_2mortal(newSVpvn("", 0));
 #endif
 
-    DEBUG_r( if (!PL_colorset) reginitcolors() );
-    DEBUG_r(PerlIO_printf(Perl_debug_log,
-                     "%sGuessing start of match, REx%s `%s%.60s%s%s' against `%s%.*s%s%s'...\n",
-                     PL_colors[4],PL_colors[5],PL_colors[0],
-                     prog->precomp,
-                     PL_colors[1],
-                     (strlen(prog->precomp) > 60 ? "..." : ""),
-                     PL_colors[0],
-                     (int)(strend - strpos > 60 ? 60 : strend - strpos),
-                     strpos, PL_colors[1],
-                     (strend - strpos > 60 ? "..." : ""))
-       );
+    DEBUG_r({
+        char   *s   = UTF ? sv_uni_display(dsv, sv, 60, 0) : strpos;
+        STRLEN  len = UTF ? strlen(s) : strend - strpos;
+        if (!PL_colorset)
+             reginitcolors();
+        PerlIO_printf(Perl_debug_log,
+                      "%sGuessing start of match, REx%s `%s%.60s%s%s' against `%s%.*s%s%s'...\n",
+                      PL_colors[4],PL_colors[5],PL_colors[0],
+                      prog->precomp,
+                      PL_colors[1],
+                      (strlen(prog->precomp) > 60 ? "..." : ""),
+                      PL_colors[0],
+                      (int)(len > 60 ? 60 : len),
+                      s, PL_colors[1],
+                      (len > 60 ? "..." : "")
+             );
+    });
 
     if (prog->reganch & ROPT_UTF8)
        PL_reg_flags |= RF_utf8;
@@ -1450,6 +1456,9 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     char *scream_olds;
     SV* oreplsv = GvSV(PL_replgv);
     bool do_utf8 = DO_UTF8(sv);
+#ifdef DEBUGGING
+    SV *dsv = sv_2mortal(newSVpvn("", 0));
+#endif
 
     PL_regcc = 0;
 
@@ -1532,18 +1541,23 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
            goto phooey;        /* not present */
     }
 
-    DEBUG_r( if (!PL_colorset) reginitcolors() );
-    DEBUG_r(PerlIO_printf(Perl_debug_log,
-                     "%sMatching REx%s `%s%.60s%s%s' against `%s%.*s%s%s'\n",
-                     PL_colors[4],PL_colors[5],PL_colors[0],
-                     prog->precomp,
-                     PL_colors[1],
-                     (strlen(prog->precomp) > 60 ? "..." : ""),
-                     PL_colors[0],
-                     (int)(strend - startpos > 60 ? 60 : strend - startpos),
-                     startpos, PL_colors[1],
-                     (strend - startpos > 60 ? "..." : ""))
-       );
+    DEBUG_r({
+        char   *s   = UTF ? sv_uni_display(dsv, sv, 60, 0) : startpos;
+        STRLEN  len = UTF ? strlen(s) : strend - startpos;
+        if (!PL_colorset)
+            reginitcolors();
+        PerlIO_printf(Perl_debug_log,
+                      "%sMatching REx%s `%s%.60s%s%s' against `%s%.*s%s%s'\n",
+                      PL_colors[4],PL_colors[5],PL_colors[0],
+                      prog->precomp,
+                      PL_colors[1],
+                      (strlen(prog->precomp) > 60 ? "..." : ""),
+                      PL_colors[0],
+                      (int)(len > 60 ? 60 : len),
+                      s, PL_colors[1],
+                      (len > 60 ? "..." : "")
+             );
+    });
 
     /* Simplest case:  anchored match need be tried only once. */
     /*  [unless only anchor is BOL and multiline is set] */
@@ -1713,7 +1727,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
        DEBUG_r({
            SV *prop = sv_newmortal();
            regprop(prop, c);
-           PerlIO_printf(Perl_debug_log, "Matching stclass `%s' against `%s'\n", SvPVX(prop), s);
+           PerlIO_printf(Perl_debug_log, "Matching stclass `%s' against `%s'\n", SvPVX(prop), UTF ? sv_uni_display(dsv, sv, 60, 0) : s);
        });
        if (find_byclass(prog, c, s, strend, startpos, 0))
            goto got_it;
@@ -2026,6 +2040,11 @@ S_regmatch(pTHX_ regnode *prog)
     I32 firstcp = PL_savestack_ix;
 #endif
     register bool do_utf8 = PL_reg_match_utf8;
+#ifdef DEBUGGING
+    SV *dsv0 = sv_2mortal(newSVpvn("", 0));
+    SV *dsv1 = sv_2mortal(newSVpvn("", 0));
+    SV *dsv2 = sv_2mortal(newSVpvn("", 0));
+#endif
 
 #ifdef DEBUGGING
     PL_regindent++;
@@ -2036,7 +2055,7 @@ S_regmatch(pTHX_ regnode *prog)
     scan = prog;
     while (scan != NULL) {
 
-       DEBUG_r( {
+        DEBUG_r( {
            SV *prop = sv_newmortal();
            int docolor = *PL_colors[0];
            int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
@@ -2064,20 +2083,42 @@ S_regmatch(pTHX_ regnode *prog)
            if (pref0_len > pref_len)
                pref0_len = pref_len;
            regprop(prop, scan);
-           PerlIO_printf(Perl_debug_log,
-                         "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n",
-                         (IV)(locinput - PL_bostr),
-                         PL_colors[4], pref0_len,
-                         locinput - pref_len, PL_colors[5],
-                         PL_colors[2], pref_len - pref0_len,
-                         locinput - pref_len + pref0_len, PL_colors[3],
-                         (docolor ? "" : "> <"),
-                         PL_colors[0], l, locinput, PL_colors[1],
-                         15 - l - pref_len + 1,
-                         "",
-                         (IV)(scan - PL_regprogram), PL_regindent*2, "",
-                         SvPVX(prop));
-       } );
+           {
+             char *s0 =
+               UTF ?
+               pv_uni_display(dsv0, (U8*)(locinput - pref_len),
+                              pref0_len, 60, 0) :
+               locinput - pref_len;
+             STRLEN len0 = UTF ? strlen(s0) : pref0_len;
+             char *s1 = UTF ?
+               pv_uni_display(dsv1, (U8*)(locinput - pref_len + pref0_len),
+                              pref_len - pref0_len, 60, 0) :
+               locinput - pref_len + pref0_len;
+             STRLEN len1 = UTF ? strlen(s1) : pref_len - pref0_len;
+             char *s2 = UTF ?
+               pv_uni_display(dsv2, (U8*)locinput,
+                              PL_regeol - locinput, 60, 0) :
+               locinput;
+             STRLEN len2 = UTF ? strlen(s2) : l;
+             PerlIO_printf(Perl_debug_log,
+                           "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n",
+                           (IV)(locinput - PL_bostr),
+                           PL_colors[4],
+                           len0, s0,
+                           PL_colors[5],
+                           PL_colors[2],
+                           len1, s1,
+                           PL_colors[3],
+                           (docolor ? "" : "> <"),
+                           PL_colors[0],
+                           len2, s2,
+                           PL_colors[1],
+                           15 - l - pref_len + 1,
+                           "",
+                           (IV)(scan - PL_regprogram), PL_regindent*2, "",
+                           SvPVX(prop));
+           }
+       });
 
        next = scan + NEXT_OFF(scan);
        if (next == scan)