From: Jarkko Hietaniemi Date: Wed, 24 Oct 2001 14:08:39 +0000 (+0000) Subject: Dump Unicode better for re 'debug'. The regprop() X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2a782b5b3455b969a393225d1de6c0e14aaee79e;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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)