From: Yves Orton Date: Sat, 15 Jul 2006 18:56:03 +0000 (+0200) Subject: Updated escaping code. utf8 regex debug output improvements X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ab3bbdeb874c2a82798e2c9cc4b61acf5866b410;p=p5sagit%2Fp5-mst-13.2.git Updated escaping code. utf8 regex debug output improvements Message-Id: <9b18b3110607150956o6273a16clb1518911d1945d4@mail.gmail.com> p4raw-id: //depot/perl@28582 --- diff --git a/dump.c b/dump.c index 98405c6..f9cd28d 100644 --- a/dump.c +++ b/dump.c @@ -121,92 +121,179 @@ Perl_dump_eval(pTHX) /* -=for apidoc Apd|char*|pv_escape|NN SV *dsv|NN const char *pv|const STRLEN count|const STRLEN max|const U32 flags +=for apidoc Apd|char*|pv_escape|NN SV *dsv|NN const U8 const *str\ + |const STRLEN count|const STRLEN max + |STRLEN const *escaped, const U32 flags Escapes at most the first "count" chars of pv and puts the results into -buf such that the size of the escaped string will not exceed "max" chars +dsv such that the size of the escaped string will not exceed "max" chars and will not contain any incomplete escape sequences. -If flags contains PERL_PV_ESCAPE_QUOTE then the string will have quotes -placed around it; moreover, if the number of chars converted was less than -"count" then a trailing elipses (...) will be added after the closing -quote. - -If PERL_PV_ESCAPE_QUOTE is not set, but PERL_PV_ESCAPE_PADR is, then the -returned string will be right padded with spaces such that it is max chars -long. +If flags contains PERL_PV_ESCAPE_QUOTE then any double quotes in the string +will also be escaped. Normally the SV will be cleared before the escaped string is prepared, -but when PERL_PV_ESCAPE_CAT is set this will not occur. +but when PERL_PV_ESCAPE_NOCLEAR is set this will not occur. + +If PERL_PV_ESCAPE_UNI is set then the input string is treated as unicode, +if PERL_PV_ESCAPE_UNI_DETECT is set then the input string is scanned +using C to determine if it is unicode. + +If PERL_PV_ESCAPE_ALL is set then all input chars will be output +using C<\x01F1> style escapes, otherwise only chars above 255 will be +escaped using this style, other non printable chars will use octal or +common escaped patterns like C<\n>. If PERL_PV_ESCAPE_NOBACKSLASH +then all chars below 255 will be treated as printable and +will be output as literals. -Returns a pointer to the string contained by SV. +If PERL_PV_ESCAPE_FIRSTCHAR is set then only the first char of the +string will be escaped, regardles of max. If the string is utf8 and +the chars value is >255 then it will be returned as a plain hex +sequence. Thus the output will either be a single char, +an octal escape sequence, a special escape like C<\n> or a 3 or +more digit hex value. + +Returns a pointer to the escaped text as held by dsv. =cut */ - +#define PV_ESCAPE_OCTBUFSIZE 32 char * -Perl_pv_escape( pTHX_ SV *dsv, const char *pv, const STRLEN count, const STRLEN max, const U32 flags ) { - char dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : '\\'; - char octbuf[8] = "\\0123456"; - STRLEN wrote = 0; - STRLEN chsize = 0; - const char *end = pv + count; - - if (flags & PERL_PV_ESCAPE_CAT) { - if ( dq == '"' ) - sv_catpvn(dsv, "\"", 1); - } else { - if ( dq == '"' ) - sv_setpvn(dsv, "\"", 1); - else +Perl_pv_escape( pTHX_ SV *dsv, U8 const * const str, + const STRLEN count, const STRLEN max, + STRLEN * const escaped, const U32 flags ) +{ + U8 dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : '\\'; + U8 octbuf[PV_ESCAPE_OCTBUFSIZE] = "\\123456789ABCDF"; + STRLEN wrote = 0; /* chars written so far */ + STRLEN chsize = 0; /* size of data to be written */ + STRLEN readsize = 1; /* size of data just read */ + bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this unicode */ + const U8 *pv = str; + const U8 *end = pv + count; /* end of string */ + + if (!flags & PERL_PV_ESCAPE_NOCLEAR) sv_setpvn(dsv, "", 0); - } - for ( ; (pv < end && (!max || (wrote < max))) ; pv++ ) { - if ( (*pv == dq) || (*pv == '\\') || isCNTRL(*pv) ) { + + if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string(pv, count)) + isuni = 1; + + for ( ; (pv < end && (!max || (wrote < max))) ; pv += readsize ) { + const UV u= (isuni) ? utf8_to_uvchr(pv, &readsize) : *pv; + const U8 c = (U8)u & 0xFF; + + if ( ( u > 255 ) || (flags & PERL_PV_ESCAPE_ALL)) { + if (flags & PERL_PV_ESCAPE_FIRSTCHAR) + chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE, + "%"UVxf, u); + else + chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE, + "\\x{%"UVxf"}", u); + } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) { + chsize = 1; + } else { + if ( (c == dq) || (c == '\\') || !isPRINT(c) ) { chsize = 2; - switch (*pv) { + switch (c) { case '\\' : octbuf[1] = '\\'; break; case '\v' : octbuf[1] = 'v'; break; case '\t' : octbuf[1] = 't'; break; case '\r' : octbuf[1] = 'r'; break; case '\n' : octbuf[1] = 'n'; break; case '\f' : octbuf[1] = 'f'; break; - case '"' : if ( dq == *pv ) { + case '"' : + if ( dq == '"' ) octbuf[1] = '"'; + else + chsize = 1; break; - } default: - /* note the (U8*) casts here are important. - * if they are omitted we can produce the octal - * for a negative number which could produce a - * buffer overrun in octbuf, with it on we are - * guaranteed that the longest the string could be - * is 5, (we reserve 8 just because its the first - * power of 2 larger than 5.)*/ - if ( (pv < end) && isDIGIT(*(pv+1)) ) - chsize = sprintf( octbuf, "\\%03o", (U8)*pv); + if ( (pv < end) && isDIGIT(*(pv+readsize)) ) + chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE, + "\\%03o", c); else - chsize = sprintf( octbuf, "\\%o", (U8)*pv); + chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE, + "\\%o", c); + } + } else { + chsize=1; + } } if ( max && (wrote + chsize > max) ) { break; - } else { + } else if (chsize > 1) { sv_catpvn(dsv, octbuf, chsize); wrote += chsize; - } } else { - sv_catpvn(dsv, pv, 1); + Perl_sv_catpvf( aTHX_ dsv, "%c", c); wrote++; } + if ( flags & PERL_PV_ESCAPE_FIRSTCHAR ) + break; } - if ( dq == '"' ) { + if (escaped != NULL) + *escaped= pv - str; + return SvPVX(dsv); +} +/* +=for apidoc Apd|char *|pv_pretty|NN SV *dsv|NN const U8 const *str\ + |const STRLEN count|const STRLEN max\ + |const U8 const *start_color| const U8 const *end_color\ + |const U32 flags + +Converts a string into something presentable, handling escaping via +pv_escape() and supporting quoting and elipses. + +If the PERL_PV_PRETTY_QUOTE flag is set then the result will be +double quoted with any double quotes in the string escaped. Otherwise +if the PERL_PV_PRETTY_LTGT flag is set then the result be wrapped in +angle brackets. + +If the PERL_PV_PRETTY_ELIPSES flag is set and not all characters in +string were output then an elipses C<...> will be appended to the +string. Note that this happens AFTER it has been quoted. + +If start_color is non-null then it will be inserted after the opening +quote (if there is one) but before the escaped text. If end_color +is non-null then it will be inserted after the escaped text but before +any quotes or elipses. + +Returns a pointer to the prettified text as held by dsv. + +=cut +*/ + +char * +Perl_pv_pretty( pTHX_ SV *dsv, U8 const * const str, const STRLEN count, + const STRLEN max, U8 const * const start_color, U8 const * const end_color, + const U32 flags ) +{ + U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '\\'; + STRLEN escaped; + + if ( dq == '"' ) + sv_setpvn(dsv, "\"", 1); + else if ( flags & PERL_PV_PRETTY_LTGT ) + sv_setpvn(dsv, "<", 1); + else + sv_setpvn(dsv, "", 0); + + if ( start_color != NULL ) + Perl_sv_catpvf( aTHX_ dsv, "%s", start_color); + + pv_escape( dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR ); + + if ( end_color != NULL ) + Perl_sv_catpvf( aTHX_ dsv, "%s", end_color); + + if ( dq == '"' ) sv_catpvn( dsv, "\"", 1 ); - if ( pv < end ) + else if ( flags & PERL_PV_PRETTY_LTGT ) + sv_catpvn( dsv, ">", 1); + + if ( (flags & PERL_PV_PRETTY_ELIPSES) && ( escaped < count ) ) sv_catpvn( dsv, "...", 3 ); - } else if ( max && (flags & PERL_PV_ESCAPE_PADR) ) { - for ( ; wrote < max ; wrote++ ) - sv_catpvn( dsv, " ", 1 ); - } + return SvPVX(dsv); } @@ -231,7 +318,7 @@ Note that the final string may be up to 7 chars longer than pvlim. char * Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim) { - pv_escape( dsv, pv, cur, pvlim, PERL_PV_ESCAPE_QUOTE); + pv_pretty( dsv, pv, cur, pvlim, 0, 0, PERL_PV_PRETTY_DUMP); if (len > cur && pv[cur] == '\0') sv_catpvn( dsv, "\\0", 2 ); return SvPVX(dsv); diff --git a/embed.fnc b/embed.fnc index bfd7dce..f57cf92 100644 --- a/embed.fnc +++ b/embed.fnc @@ -982,8 +982,15 @@ Apdbm |void |sv_usepvn_mg |NN SV *sv|NULLOK char *ptr|STRLEN len ApR |MGVTBL*|get_vtbl |int vtbl_id Apd |char* |pv_display |NN SV *dsv|NN const char *pv|STRLEN cur|STRLEN len \ |STRLEN pvlim -Apd |char* |pv_escape |NN SV *dsv|NN const char *pv|const STRLEN count \ - |const STRLEN max|const U32 flags +Apd |char* |pv_escape |NN SV *dsv|NN U8 const * const str\ + |const STRLEN count|const STRLEN max\ + |NULLOK STRLEN * const escaped\ + |const U32 flags +Apd |char* |pv_pretty |NN SV *dsv|NN U8 const * const str\ + |const STRLEN count|const STRLEN max\ + |NULLOK U8 const * const start_color\ + |NULLOK U8 const * const end_color\ + |const U32 flags Afp |void |dump_indent |I32 level|NN PerlIO *file|NN const char* pat|... Ap |void |dump_vindent |I32 level|NN PerlIO *file|NN const char* pat \ |NULLOK va_list *args @@ -1354,6 +1361,7 @@ Es |void |to_utf8_substr |NN regexp * prog Es |void |to_byte_substr |NN regexp * prog # ifdef DEBUGGING Es |void |dump_exec_pos |NN const char *locinput|NN const regnode *scan|const bool do_utf8 +Es |void |debug_start_match|NN const regexp *prog|const bool do_utf8|NN const char *start|NN const char *end|NN const char *blurb # endif #endif diff --git a/ext/re/re.pm b/ext/re/re.pm index 08abfa1..51545ac 100644 --- a/ext/re/re.pm +++ b/ext/re/re.pm @@ -233,6 +233,7 @@ my %flags = ( EXTRA => 0xFF0000, TRIE_MORE => 0x010000, OFFSETS_DEBUG => 0x020000, + STATE => 0x040000, ); $flags{ALL} = $flags{COMPILE} | $flags{EXECUTE}; $flags{All} = $flags{all} = $flags{DUMP} | $flags{EXECUTE}; diff --git a/perl.h b/perl.h index e4c8755..949fb51 100644 --- a/perl.h +++ b/perl.h @@ -5646,12 +5646,32 @@ extern void moncontrol(int); so that Configure picks them up. */ -/* these are used by Perl_pv_escape() and are here so that they - * are available throughout the core */ +/* These are used by Perl_pv_escape() and Perl_pv_pretty() + * are here so that they are available throughout the core + * NOTE that even though some are for _escape and some for _pretty + * there must not be any clashes as the flags from _pretty are + * passed straight through to _escape. + */ + +#define PERL_PV_ESCAPE_QUOTE 0x0001 +#define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE + + +#define PERL_PV_PRETTY_ELIPSES 0x0002 +#define PERL_PV_PRETTY_LTGT 0x0004 + +#define PERL_PV_ESCAPE_FIRSTCHAR 0x0008 + +#define PERL_PV_ESCAPE_UNI 0x0100 +#define PERL_PV_ESCAPE_UNI_DETECT 0x0200 + +#define PERL_PV_ESCAPE_ALL 0x1000 +#define PERL_PV_ESCAPE_NOBACKSLASH 0x2000 +#define PERL_PV_ESCAPE_NOCLEAR 0x4000 -#define PERL_PV_ESCAPE_QUOTE 1 -#define PERL_PV_ESCAPE_PADR 2 -#define PERL_PV_ESCAPE_CAT 4 +/* used by pv_display in dump.c*/ +#define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELIPSES|PERL_PV_PRETTY_QUOTE +#define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELIPSES|PERL_PV_PRETTY_LTGT #endif /* Include guard */ diff --git a/regcomp.c b/regcomp.c index 10c6682..0842448 100644 --- a/regcomp.c +++ b/regcomp.c @@ -754,6 +754,7 @@ is the recommended Unicode-aware way of saying #define TRIE_STORE_REVCHAR \ STMT_START { \ SV *tmp = Perl_newSVpvf_nocontext( "%c", (int)uvc ); \ + if (UTF) SvUTF8_on(tmp); \ av_push( TRIE_REVCHARMAP(trie), tmp ); \ } STMT_END @@ -852,8 +853,11 @@ STATIC void S_dump_trie(pTHX_ const struct _reg_trie_data *trie,U32 depth) { U32 state; + SV *sv=sv_newmortal(); + int colwidth= trie->widecharmap ? 6 : 4; GET_RE_DEBUG_FLAGS_DECL; + PerlIO_printf( Perl_debug_log, "%*sChar : %-6s%-6s%-4s ", (int)depth * 2 + 2,"", "Match","Base","Ofs" ); @@ -861,14 +865,21 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie,U32 depth) for( state = 0 ; state < trie->uniquecharcount ; state++ ) { SV ** const tmp = av_fetch( trie->revcharmap, state, 0); if ( tmp ) { - PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen_const( *tmp ) ); + PerlIO_printf( Perl_debug_log, "%*s", + colwidth, + pv_pretty(sv, (U8*)SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, + PL_colors[0], PL_colors[1], + (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) | + PERL_PV_ESCAPE_FIRSTCHAR + ) + ); } } PerlIO_printf( Perl_debug_log, "\n%*sState|-----------------------", (int)depth * 2 + 2,""); for( state = 0 ; state < trie->uniquecharcount ; state++ ) - PerlIO_printf( Perl_debug_log, "-----"); + PerlIO_printf( Perl_debug_log, "%.*s", colwidth, "--------"); PerlIO_printf( Perl_debug_log, "\n"); for( state = 1 ; state < TRIE_LASTSTATE(trie) ; state++ ) { @@ -899,10 +910,11 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie,U32 depth) ( base + ofs - trie->uniquecharcount < trie->lasttrans ) && trie->trans[ base + ofs - trie->uniquecharcount ].check == state ) { - PerlIO_printf( Perl_debug_log, "%4"UVXf" ", + PerlIO_printf( Perl_debug_log, "%*"UVXf, + colwidth, (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next ); } else { - PerlIO_printf( Perl_debug_log, "%4s "," ." ); + PerlIO_printf( Perl_debug_log, "%*s",colwidth," ." ); } } @@ -923,16 +935,18 @@ STATIC void S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, U32 next_alloc,U32 depth) { U32 state; + SV *sv=sv_newmortal(); + int colwidth= trie->widecharmap ? 6 : 4; GET_RE_DEBUG_FLAGS_DECL; /* print out the table precompression. */ - PerlIO_printf( Perl_debug_log, "%*sState :Word | Transition Data\n%*s", - (int)depth * 2 + 2,"", (int)depth * 2 + 2,""); - PerlIO_printf( Perl_debug_log, "------:-----+-----------------" ); + PerlIO_printf( Perl_debug_log, "%*sState :Word | Transition Data\n%*s%s", + (int)depth * 2 + 2,"", (int)depth * 2 + 2,"", + "------:-----+-----------------\n" ); for( state=1 ; state < next_alloc ; state ++ ) { U16 charid; - PerlIO_printf( Perl_debug_log, "\n%*s %4"UVXf" :", + PerlIO_printf( Perl_debug_log, "%*s %4"UVXf" :", (int)depth * 2 + 2,"", (UV)state ); if ( ! trie->states[ state ].wordnum ) { PerlIO_printf( Perl_debug_log, "%5s| ",""); @@ -943,13 +957,20 @@ S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, U32 next_alloc } for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) { SV ** const tmp = av_fetch( trie->revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0); - PerlIO_printf( Perl_debug_log, "%s:%3X=%4"UVXf" | ", - SvPV_nolen_const( *tmp ), + if ( tmp ) { + PerlIO_printf( Perl_debug_log, "%*s:%3X=%4"UVXf" | ", + colwidth, + pv_pretty(sv, (U8*)SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, + PL_colors[0], PL_colors[1], + (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) | + PERL_PV_ESCAPE_FIRSTCHAR + ) , TRIE_LIST_ITEM(state,charid).forid, (UV)TRIE_LIST_ITEM(state,charid).newstate ); } - + } + PerlIO_printf( Perl_debug_log, "\n"); } } @@ -965,6 +986,8 @@ S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, U32 next_allo { U32 state; U16 charid; + SV *sv=sv_newmortal(); + int colwidth= trie->widecharmap ? 6 : 4; GET_RE_DEBUG_FLAGS_DECL; /* @@ -977,14 +1000,21 @@ S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, U32 next_allo for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) { SV ** const tmp = av_fetch( trie->revcharmap, charid, 0); if ( tmp ) { - PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen_const( *tmp ) ); + PerlIO_printf( Perl_debug_log, "%*s", + colwidth, + pv_pretty(sv, (U8*)SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, + PL_colors[0], PL_colors[1], + (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) | + PERL_PV_ESCAPE_FIRSTCHAR + ) + ); } } PerlIO_printf( Perl_debug_log, "\n%*sState+-",(int)depth * 2 + 2,"" ); for( charid=0 ; charid < trie->uniquecharcount ; charid++ ) { - PerlIO_printf( Perl_debug_log, "%4s-", "----" ); + PerlIO_printf( Perl_debug_log, "%.*s", colwidth,"--------"); } PerlIO_printf( Perl_debug_log, "\n" ); @@ -996,8 +1026,11 @@ S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, U32 next_allo (UV)TRIE_NODENUM( state ) ); for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) { - PerlIO_printf( Perl_debug_log, "%4"UVXf" ", - (UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next ) ); + UV v=(UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next ); + if (v) + PerlIO_printf( Perl_debug_log, "%*"UVXf, colwidth, v ); + else + PerlIO_printf( Perl_debug_log, "%*s", colwidth, "." ); } if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) { PerlIO_printf( Perl_debug_log, " (%4"UVXf")\n", (UV)trie->trans[ state ].check ); @@ -3231,9 +3264,11 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) RExC_precomp = exp; DEBUG_r(if (!PL_colorset) reginitcolors()); DEBUG_COMPILE_r({ - PerlIO_printf(Perl_debug_log, "%sCompiling REx%s \"%s%*s%s\"\n", - PL_colors[4],PL_colors[5],PL_colors[0], - (int)(xend - exp), RExC_precomp, PL_colors[1]); + SV *dsv= sv_newmortal(); + RE_PV_QUOTED_DECL(s, RExC_utf8, + dsv, RExC_precomp, (xend - exp), 60); + PerlIO_printf(Perl_debug_log, "%sCompiling REx%s %s\n", + PL_colors[4],PL_colors[5],s); }); RExC_flags = pm->op_pmflags; RExC_sawback = 0; @@ -6314,46 +6349,41 @@ Perl_regdump(pTHX_ const regexp *r) #ifdef DEBUGGING dVAR; SV * const sv = sv_newmortal(); + SV *dsv= sv_newmortal(); (void)dumpuntil(r, r->program, r->program + 1, NULL, sv, 0); /* Header fields of interest. */ - if (r->anchored_substr) + if (r->anchored_substr) { + RE_PV_QUOTED_DECL(s, 0, dsv, SvPVX_const(r->anchored_substr), + RE_SV_DUMPLEN(r->anchored_substr), 30); PerlIO_printf(Perl_debug_log, - "anchored \"%s%.*s%s\"%s at %"IVdf" ", - PL_colors[0], - (int)(SvCUR(r->anchored_substr) - (SvTAIL(r->anchored_substr)!=0)), - SvPVX_const(r->anchored_substr), - PL_colors[1], - SvTAIL(r->anchored_substr) ? "$" : "", + "anchored %s%s at %"IVdf" ", + s, RE_SV_TAIL(r->anchored_substr), (IV)r->anchored_offset); - else if (r->anchored_utf8) + } else if (r->anchored_utf8) { + RE_PV_QUOTED_DECL(s, 1, dsv, SvPVX_const(r->anchored_utf8), + RE_SV_DUMPLEN(r->anchored_utf8), 30); PerlIO_printf(Perl_debug_log, - "anchored utf8 \"%s%.*s%s\"%s at %"IVdf" ", - PL_colors[0], - (int)(SvCUR(r->anchored_utf8) - (SvTAIL(r->anchored_utf8)!=0)), - SvPVX_const(r->anchored_utf8), - PL_colors[1], - SvTAIL(r->anchored_utf8) ? "$" : "", + "anchored utf8 %s%s at %"IVdf" ", + s, RE_SV_TAIL(r->anchored_utf8), (IV)r->anchored_offset); - if (r->float_substr) + } + if (r->float_substr) { + RE_PV_QUOTED_DECL(s, 0, dsv, SvPVX_const(r->float_substr), + RE_SV_DUMPLEN(r->float_substr), 30); PerlIO_printf(Perl_debug_log, - "floating \"%s%.*s%s\"%s at %"IVdf"..%"UVuf" ", - PL_colors[0], - (int)(SvCUR(r->float_substr) - (SvTAIL(r->float_substr)!=0)), - SvPVX_const(r->float_substr), - PL_colors[1], - SvTAIL(r->float_substr) ? "$" : "", + "floating %s%s at %"IVdf"..%"UVuf" ", + s, RE_SV_TAIL(r->float_substr), (IV)r->float_min_offset, (UV)r->float_max_offset); - else if (r->float_utf8) + } else if (r->float_utf8) { + RE_PV_QUOTED_DECL(s, 1, dsv, SvPVX_const(r->float_utf8), + RE_SV_DUMPLEN(r->float_utf8), 30); PerlIO_printf(Perl_debug_log, - "floating utf8 \"%s%.*s%s\"%s at %"IVdf"..%"UVuf" ", - PL_colors[0], - (int)(SvCUR(r->float_utf8) - (SvTAIL(r->float_utf8)!=0)), - SvPVX_const(r->float_utf8), - PL_colors[1], - SvTAIL(r->float_utf8) ? "$" : "", + "floating utf8 %s%s at %"IVdf"..%"UVuf" ", + s, RE_SV_TAIL(r->float_utf8), (IV)r->float_min_offset, (UV)r->float_max_offset); + } if (r->check_substr || r->check_utf8) PerlIO_printf(Perl_debug_log, r->check_substr == r->float_substr @@ -6419,16 +6449,18 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o) if (k == EXACT) { SV * const dsv = sv_2mortal(newSVpvs("")); - /* Using is_utf8_string() is a crude hack but it may - * be the best for now since we have no flag "this EXACTish - * node was UTF-8" --jhi */ - const bool do_utf8 = is_utf8_string((U8*)STRING(o), STR_LEN(o)); - RE_PV_DISPLAY_DECL(s, len, do_utf8, dsv, STRING(o), STR_LEN(o), 60); - - Perl_sv_catpvf(aTHX_ sv, " <%s%.*s%s>", - PL_colors[0], - len, s, - PL_colors[1]); + /* Using is_utf8_string() (via PERL_PV_UNI_DETECT) + * is a crude hack but it may be the best for now since + * we have no flag "this EXACTish node was UTF-8" + * --jhi */ + const char * const s = + pv_pretty(dsv, (U8*)STRING(o), STR_LEN(o), 60, + PL_colors[0], PL_colors[1], + PERL_PV_ESCAPE_UNI_DETECT | + PERL_PV_PRETTY_ELIPSES | + PERL_PV_PRETTY_LTGT + ); + Perl_sv_catpvf(aTHX_ sv, " %s", s ); } else if (k == TRIE) { Perl_sv_catpvf(aTHX_ sv, "-%s",reg_name[o->flags]); /* print the details of the trie in dumpuntil instead, as @@ -6630,18 +6662,16 @@ Perl_pregfree(pTHX_ struct regexp *r) if (!r || (--r->refcnt > 0)) return; - DEBUG_COMPILE_r(if (RX_DEBUG(r)){ - RE_PV_DISPLAY_DECL(s, len, (r->reganch & ROPT_UTF8), - PERL_DEBUG_PAD_ZERO(0), r->precomp, r->prelen, 60); - + DEBUG_COMPILE_r({ if (!PL_colorset) reginitcolors(); - PerlIO_printf(Perl_debug_log, - "%sFreeing REx:%s %s%*.*s%s%s\n", - PL_colors[4],PL_colors[5],PL_colors[0], - len, len, s, - PL_colors[1], - len > 60 ? "..." : ""); + if (RX_DEBUG(r)){ + SV *dsv= sv_newmortal(); + RE_PV_QUOTED_DECL(s, (r->reganch & ROPT_UTF8), + dsv, r->precomp, r->prelen, 60); + PerlIO_printf(Perl_debug_log,"%sFreeing REx:%s %s\n", + PL_colors[4],PL_colors[5],s); + } }); /* gcov results gave these as non-null 100% of the time, so there's no @@ -6996,15 +7026,17 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, for (word_idx=0; word_idx < arry_len; word_idx++) { SV ** const elem_ptr = av_fetch(trie->words,word_idx,0); - if (elem_ptr) { - PerlIO_printf(Perl_debug_log, "%*s<%s%s%s>\n", + if (elem_ptr) + PerlIO_printf(Perl_debug_log, "%*s%s\n", (int)(2*(l+4)), "", - PL_colors[0], - SvPV_nolen_const(*elem_ptr), - PL_colors[1] + pv_pretty(sv, (U8*)SvPV_nolen_const(*elem_ptr), SvCUR(*elem_ptr), 60, + PL_colors[0], PL_colors[1], + (SvUTF8(*elem_ptr) ? PERL_PV_ESCAPE_UNI : 0) | + PERL_PV_PRETTY_ELIPSES | + PERL_PV_PRETTY_LTGT + ) ); } - } node = NEXTOPER(node); node += regarglen[(U8)op]; diff --git a/regcomp.h b/regcomp.h index 535897f..e46f6f4 100644 --- a/regcomp.h +++ b/regcomp.h @@ -567,6 +567,7 @@ re.pm, especially to the documentation. #define RE_DEBUG_EXTRA_MASK 0xFF0000 #define RE_DEBUG_EXTRA_TRIE 0x010000 #define RE_DEBUG_EXTRA_OFFSETS 0x020000 +#define RE_DEBUG_EXTRA_STATE 0x040000 #define RE_DEBUG_FLAG(x) (re_debug_flags & x) /* Compile */ @@ -598,6 +599,8 @@ re.pm, especially to the documentation. /* Extra */ #define DEBUG_EXTRA_r(x) DEBUG_r( \ if (re_debug_flags & RE_DEBUG_EXTRA_MASK) x ) +#define DEBUG_STATE_r(x) DEBUG_r( \ + if (re_debug_flags & RE_DEBUG_EXTRA_STATE) x ) #define MJD_OFFSET_DEBUG(x) DEBUG_r( \ if (re_debug_flags & RE_DEBUG_EXTRA_OFFSETS) \ Perl_warn_nocontext x ) @@ -623,14 +626,41 @@ re.pm, especially to the documentation. }) #ifdef DEBUGGING + #define GET_RE_DEBUG_FLAGS_DECL IV re_debug_flags = 0; GET_RE_DEBUG_FLAGS; -#define RE_PV_DISPLAY_DECL(rpv,rlen,isuni,dsv,pv,l,m) \ - const char * const rpv = (isuni) ? \ - pv_uni_display(dsv, (U8*)(pv), l, m, UNI_DISPLAY_REGEX) : \ - pv_escape(dsv, pv, l, m, 0); \ + +#define RE_PV_COLOR_DECL(rpv,rlen,isuni,dsv,pv,l,m,c1,c2) \ + const char * const rpv = \ + pv_pretty((dsv), (U8*)(pv), (l), (m), \ + PL_colors[(c1)],PL_colors[(c2)], \ + ((isuni) ? PERL_PV_ESCAPE_UNI : 0) ); \ const int rlen = SvCUR(dsv) -#else + +#define RE_SV_ESCAPE(rpv,isuni,dsv,sv,m) \ + const char * const rpv = \ + pv_pretty((dsv), (U8*)(SvPV_nolen_const(sv)), (SvCUR(sv)), (m), \ + PL_colors[(c1)],PL_colors[(c2)], \ + ((isuni) ? PERL_PV_ESCAPE_UNI : 0) ) + +#define RE_PV_QUOTED_DECL(rpv,isuni,dsv,pv,l,m) \ + const char * const rpv = \ + pv_pretty((dsv), (U8*)(pv), (l), (m), \ + PL_colors[0], PL_colors[1], \ + ( PERL_PV_PRETTY_QUOTE | PERL_PV_PRETTY_ELIPSES | \ + ((isuni) ? PERL_PV_ESCAPE_UNI : 0)) \ + ) + +#define RE_SV_DUMPLEN(ItEm) (SvCUR(ItEm) - (SvTAIL(ItEm)!=0)) +#define RE_SV_TAIL(ItEm) (SvTAIL(ItEm) ? "$" : "") + +#else /* if not DEBUGGING */ + #define GET_RE_DEBUG_FLAGS_DECL -#define RE_PV_DISPLAY_DECL -#endif +#define RE_PV_COLOR_DECL(rpv,rlen,isuni,dsv,pv,l,m,c1,c2) +#define RE_SV_ESCAPE(rpv,isuni,dsv,sv,m) +#define RE_PV_QUOTED_DECL(rpv,isuni,dsv,pv,l,m) +#define RE_SV_DUMPLEN(ItEm) +#define RE_SV_TAIL(ItEm) + +#endif /* DEBUG RELATED DEFINES */ diff --git a/regexec.c b/regexec.c index 44f893e..3eee31e 100644 --- a/regexec.c +++ b/regexec.c @@ -78,7 +78,7 @@ #define RF_tainted 1 /* tainted information used? */ #define RF_warned 2 /* warned about big count? */ #define RF_evaled 4 /* Did an EVAL with setting? */ -#define RF_utf8 8 /* String contains multibyte chars? */ +#define RF_utf8 8 /* Pattern contains multibyte chars? */ #define UTF ((PL_reg_flags & RF_utf8) != 0) @@ -195,14 +195,21 @@ S_regcppush(pTHX_ I32 parenfloor) } /* These are needed since we do not localize EVAL nodes: */ -# define REGCP_SET(cp) DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, \ +#define REGCP_SET(cp) \ + DEBUG_STATE_r( \ + if (cp != PL_savestack_ix) \ + PerlIO_printf(Perl_debug_log, \ " Setting an EVAL scope, savestack=%"IVdf"\n", \ - (IV)PL_savestack_ix)); cp = PL_savestack_ix + (IV)PL_savestack_ix)); \ + cp = PL_savestack_ix -# define REGCP_UNWIND(cp) DEBUG_EXECUTE_r(cp != PL_savestack_ix ? \ +#define REGCP_UNWIND(cp) \ + DEBUG_EXECUTE_r( \ + if (cp != PL_savestack_ix) \ PerlIO_printf(Perl_debug_log, \ " Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \ - (IV)(cp), (IV)PL_savestack_ix) : 0); regcpblow(cp) + (IV)(cp), (IV)PL_savestack_ix)); \ + regcpblow(cp) STATIC char * S_regcppop(pTHX_ const regexp *rex) @@ -364,32 +371,12 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, RX_MATCH_UTF8_set(prog,do_utf8); if (prog->reganch & ROPT_UTF8) { - DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, - "UTF-8 regex...\n")); PL_reg_flags |= RF_utf8; } - - DEBUG_EXECUTE_r({ - RE_PV_DISPLAY_DECL(s, len, PL_reg_match_utf8, - PERL_DEBUG_PAD_ZERO(0), strpos, strend - strpos, 60); - - if (!PL_colorset) - reginitcolors(); - if (PL_reg_match_utf8) - DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, - "UTF-8 target...\n")); - 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 ? "..." : "") + DEBUG_EXECUTE_r( + debug_start_match(prog, do_utf8, strpos, strend, + "Guessing start of match for"); ); - }); /* CHR_DIST() would be more correct here but it makes things slow. */ if (prog->minlen > strend - strpos) { @@ -520,14 +507,17 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, /* Update the count-of-usability, remove useless subpatterns, unshift s. */ - DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s %s substr \"%s%.*s%s\"%s%s", + DEBUG_EXECUTE_r({ + RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0), + SvPVX_const(check), RE_SV_DUMPLEN(check), 30); + PerlIO_printf(Perl_debug_log, "%s %s substr %s%s%s", (s ? "Found" : "Did not find"), - (check == (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) ? "anchored" : "floating"), - PL_colors[0], - (int)(SvCUR(check) - (SvTAIL(check)!=0)), - SvPVX_const(check), - PL_colors[1], (SvTAIL(check) ? "$" : ""), - (s ? " at offset " : "...\n") ) ); + (check == (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) + ? "anchored" : "floating"), + quoted, + RE_SV_TAIL(check), + (s ? " at offset " : "...\n") ); + }); if (!s) goto fail_finish; @@ -587,14 +577,15 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, must, multiline ? FBMrf_MULTILINE : 0 ); - DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, - "%s anchored substr \"%s%.*s%s\"%s", + DEBUG_EXECUTE_r({ + RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0), + SvPVX_const(must), RE_SV_DUMPLEN(must), 30); + PerlIO_printf(Perl_debug_log, "%s anchored substr %s%s", (s ? "Found" : "Contradicts"), - PL_colors[0], - (int)(SvCUR(must) - - (SvTAIL(must)!=0)), - SvPVX_const(must), - PL_colors[1], (SvTAIL(must) ? "$" : ""))); + quoted, RE_SV_TAIL(must)); + }); + + if (!s) { if (last1 >= last2) { DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, @@ -647,12 +638,13 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, (unsigned char*)last + SvCUR(must) - (SvTAIL(must)!=0), must, multiline ? FBMrf_MULTILINE : 0); - DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s floating substr \"%s%.*s%s\"%s", + DEBUG_EXECUTE_r({ + RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0), + SvPVX_const(must), RE_SV_DUMPLEN(must), 30); + PerlIO_printf(Perl_debug_log, "%s floating substr %s%s", (s ? "Found" : "Contradicts"), - PL_colors[0], - (int)(SvCUR(must) - (SvTAIL(must)!=0)), - SvPVX_const(must), - PL_colors[1], (SvTAIL(must) ? "$" : ""))); + quoted, RE_SV_TAIL(must)); + }); if (!s) { if (last1 == last) { DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, @@ -1603,26 +1595,10 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * } } - DEBUG_EXECUTE_r({ - RE_PV_DISPLAY_DECL(s0, len0, UTF, - PERL_DEBUG_PAD_ZERO(0), prog->precomp, prog->prelen, 60); - RE_PV_DISPLAY_DECL(s1, len1, do_utf8, - PERL_DEBUG_PAD_ZERO(1), startpos, strend - startpos, 60); - - if (!PL_colorset) - reginitcolors(); - PerlIO_printf(Perl_debug_log, - "%sMatching REx%s \"%s%*.*s%s%s\" against \"%s%.*s%s%s\"\n", - PL_colors[4], PL_colors[5], PL_colors[0], - len0, len0, s0, - PL_colors[1], - len0 > 60 ? "..." : "", - PL_colors[0], - (int)(len1 > 60 ? 60 : len1), - s1, PL_colors[1], - (len1 > 60 ? "..." : "") + DEBUG_EXECUTE_r( + debug_start_match(prog, do_utf8, startpos, strend, + "Matching"); ); - }); /* Simplest case: anchored match need be tried only once. */ /* [unless only anchor is BOL and multiline is set] */ @@ -1790,16 +1766,14 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * } } } - DEBUG_EXECUTE_r(if (!did_match) - PerlIO_printf(Perl_debug_log, - "Did not find %s substr \"%s%.*s%s\"%s...\n", + DEBUG_EXECUTE_r(if (!did_match) { + RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0), + SvPVX_const(must), RE_SV_DUMPLEN(must), 30); + PerlIO_printf(Perl_debug_log, "Did not find %s substr %s%s...\n", ((must == prog->anchored_substr || must == prog->anchored_utf8) ? "anchored" : "floating"), - PL_colors[0], - (int)(SvCUR(must) - (SvTAIL(must)!=0)), - SvPVX_const(must), - PL_colors[1], (SvTAIL(must) ? "$" : "")) - ); + quoted, RE_SV_TAIL(must)); + }); goto phooey; } else if ((c = prog->regstclass)) { @@ -1813,14 +1787,12 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * SV * const prop = sv_newmortal(); regprop(prog, prop, c); { - RE_PV_DISPLAY_DECL(s0,len0,UTF, - PERL_DEBUG_PAD_ZERO(0),SvPVX_const(prop),SvCUR(prop),60); - RE_PV_DISPLAY_DECL(s1,len1,UTF, - PERL_DEBUG_PAD_ZERO(1),s,strend-s,60); + RE_PV_QUOTED_DECL(quoted,UTF,PERL_DEBUG_PAD_ZERO(1), + s,strend-s,60); PerlIO_printf(Perl_debug_log, - "Matching stclass \"%*.*s\" against \"%*.*s\" (%d chars)\n", - len0, len0, s0, - len1, len1, s1, (int)(strend - s)); + "Matching stclass %.*s against %s (%d chars)\n", + SvCUR(prop), SvPVX_const(prop), + quoted, (int)(strend - s)); } }); if (find_byclass(prog, c, s, strend, ®info)) @@ -2305,6 +2277,31 @@ S_push_slab(pTHX) #define REG_NODE_NUM(x) ((x) ? (int)((x)-prog) : -1) #ifdef DEBUGGING +STATIC void +S_debug_start_match(pTHX_ const regexp *prog, const bool do_utf8, + const char *start, const char *end, const char *blurb) +{ + const bool utf8_pat= prog->reganch & ROPT_UTF8 ? 1 : 0; + if (!PL_colorset) + reginitcolors(); + { + RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0), + prog->precomp, prog->prelen, 60); + + RE_PV_QUOTED_DECL(s1, do_utf8, PERL_DEBUG_PAD_ZERO(1), + start, end - start, 60); + + PerlIO_printf(Perl_debug_log, + "%s%s REx%s %s against %s\n", + PL_colors[4], blurb, PL_colors[5], s0, s1); + + if (do_utf8||utf8_pat) + PerlIO_printf(Perl_debug_log, "UTF-8 %s...\n", + !do_utf8 ? "pattern" : !utf8_pat ? "string" : + "pattern and string" + ); + } +} STATIC void S_dump_exec_pos(pTHX_ const char *locinput, const regnode *scan, const bool do_utf8) @@ -2337,29 +2334,23 @@ S_dump_exec_pos(pTHX_ const char *locinput, const regnode *scan, const bool do_u { const int is_uni = (do_utf8 && OP(scan) != CANY) ? 1 : 0; - RE_PV_DISPLAY_DECL(s0,len0,is_uni,PERL_DEBUG_PAD(0), - (locinput - pref_len),pref0_len, 60); + RE_PV_COLOR_DECL(s0,len0,is_uni,PERL_DEBUG_PAD(0), + (locinput - pref_len),pref0_len, 60, 4, 5); - RE_PV_DISPLAY_DECL(s1,len1,is_uni,PERL_DEBUG_PAD(1), + RE_PV_COLOR_DECL(s1,len1,is_uni,PERL_DEBUG_PAD(1), (locinput - pref_len + pref0_len), - pref_len - pref0_len, 60); + pref_len - pref0_len, 60, 2, 3); - RE_PV_DISPLAY_DECL(s2,len2,is_uni,PERL_DEBUG_PAD(2), - locinput, PL_regeol - locinput, 60); + RE_PV_COLOR_DECL(s2,len2,is_uni,PERL_DEBUG_PAD(2), + locinput, PL_regeol - locinput, 60, 0, 1); PerlIO_printf(Perl_debug_log, - "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|", + "%4"IVdf" <%.*s%.*s%s%.*s>%*s|", (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, ""); } @@ -3237,14 +3228,9 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog) } /* run the pattern returned from (??{...}) */ - DEBUG_EXECUTE_r( - PerlIO_printf(Perl_debug_log, - "Entering embedded \"%s%.60s%s%s\"\n", - PL_colors[0], - re->precomp, - PL_colors[1], - (strlen(re->precomp) > 60 ? "..." : "")) + debug_start_match(re, do_utf8, locinput, PL_regeol, + "Matching embedded"); ); ST.cp = regcppush(0); /* Save *all* the positions. */ @@ -3790,7 +3776,7 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog) DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, "%*s CURLYM now matched %"IVdf" times, len=%"IVdf"...\n", - (int)(REPORT_CODE_OFF+PL_regindent*2), "", + (int)(REPORT_CODE_OFF+(PL_regindent*2)), "", (IV) ST.count, (IV)ST.alen) ); @@ -3831,7 +3817,7 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog) DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, "%*s CURLYM trying tail with matches=%"IVdf"...\n", - (int)(REPORT_CODE_OFF+PL_regindent*2), + (int)(REPORT_CODE_OFF+(PL_regindent*2)), "", (IV)ST.count) ); if (ST.c1 != CHRTEST_VOID @@ -4273,7 +4259,7 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog) regmatch_state *newst; depth++; - DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, + DEBUG_STATE_r(PerlIO_printf(Perl_debug_log, "PUSH STATE(%d)\n", depth)); st->locinput = locinput; newst = st+1; @@ -4354,7 +4340,7 @@ yes_final: st = SLAB_LAST(PL_regmatch_slab); } depth -= (st - yes_state); - DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "POP STATES (%d..%d)\n", + DEBUG_STATE_r(PerlIO_printf(Perl_debug_log, "POP STATES (%d..%d)\n", depth+1, depth+(st - yes_state))); st = yes_state; yes_state = st->u.yes.prev_yes_state; @@ -4388,7 +4374,7 @@ yes: * will disappear when REGFMATCH goes */ if (depth) { /* restore previous state and re-enter */ - DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "POP STATE(%d)\n", depth)); + DEBUG_STATE_r(PerlIO_printf(Perl_debug_log, "POP STATE(%d)\n", depth)); depth--; st--; if (st < SLAB_FIRST(PL_regmatch_slab)) { @@ -4451,7 +4437,7 @@ do_no: if (depth) { /* there's a previous state to backtrack to */ - DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "POP STATE(%d)\n", depth)); + DEBUG_STATE_r(PerlIO_printf(Perl_debug_log, "POP STATE(%d)\n", depth)); depth--; st--; if (st < SLAB_FIRST(PL_regmatch_slab)) {