Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

More escaping in the RE

Message-ID: <9b18b3110607070140p5cb2c58ftcadbcd113a58c3af@mail.gmail.com>

(with tweaks)

p4raw-id: //depot/perl@28500
  • Loading branch information...
commit 0df25f3d8d51b9b8c7ab6750af674952bc4bb6c2 1 parent 9fdc757
@demerphq demerphq authored rgs committed
Showing with 51 additions and 83 deletions.
  1. +16 −22 regcomp.c
  2. +6 −0 regcomp.h
  3. +29 −61 regexec.c
View
38 regcomp.c
@@ -6423,13 +6423,8 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
* 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));
- const char * const s = do_utf8 ?
- pv_uni_display(dsv, (U8*)STRING(o), STR_LEN(o), 60,
- UNI_DISPLAY_REGEX) :
- STRING(o);
- const int len = do_utf8 ?
- strlen(s) :
- 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,
@@ -6628,26 +6623,25 @@ void
Perl_pregfree(pTHX_ struct regexp *r)
{
dVAR;
-#ifdef DEBUGGING
- SV * const dsv = PERL_DEBUG_PAD_ZERO(0);
-#endif
+
+
+
GET_RE_DEBUG_FLAGS_DECL;
if (!r || (--r->refcnt > 0))
return;
DEBUG_COMPILE_r(if (RX_DEBUG(r)){
- const char * const s = (r->reganch & ROPT_UTF8)
- ? pv_uni_display(dsv, (U8*)r->precomp, r->prelen, 60, UNI_DISPLAY_REGEX)
- : pv_display(dsv, r->precomp, r->prelen, 0, 60);
- const int len = SvCUR(dsv);
- 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 ? "..." : "");
+ RE_PV_DISPLAY_DECL(s, len, (r->reganch & ROPT_UTF8),
+ PERL_DEBUG_PAD_ZERO(0), r->precomp, r->prelen, 60);
+
+ 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 ? "..." : "");
});
/* gcov results gave these as non-null 100% of the time, so there's no
View
6 regcomp.h
@@ -624,7 +624,13 @@ 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); \
+ const int rlen = SvCUR(dsv)
#else
#define GET_RE_DEBUG_FLAGS_DECL
+#define RE_PV_DISPLAY_DECL
#endif
View
90 regexec.c
@@ -358,7 +358,6 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
const I32 multiline = prog->reganch & PMf_MULTILINE;
#ifdef DEBUGGING
const char * const i_strpos = strpos;
- SV * const dsv = PERL_DEBUG_PAD_ZERO(0);
#endif
GET_RE_DEBUG_FLAGS_DECL;
@@ -372,11 +371,9 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
}
DEBUG_EXECUTE_r({
- const char *s = PL_reg_match_utf8 ?
- sv_uni_display(dsv, sv, 60, UNI_DISPLAY_REGEX) :
- strpos;
- const int len = PL_reg_match_utf8 ?
- (int)strlen(s) : strend - strpos;
+ 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)
@@ -1772,10 +1769,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
SV* const oreplsv = GvSV(PL_replgv);
const bool do_utf8 = DO_UTF8(sv);
I32 multiline;
-#ifdef DEBUGGING
- SV* dsv0;
- SV* dsv1;
-#endif
+
regmatch_info reginfo; /* create some info to pass to regtry etc */
GET_RE_DEBUG_FLAGS_DECL;
@@ -1791,11 +1785,6 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
multiline = prog->reganch & PMf_MULTILINE;
reginfo.prog = prog;
-#ifdef DEBUGGING
- dsv0 = PERL_DEBUG_PAD_ZERO(0);
- dsv1 = PERL_DEBUG_PAD_ZERO(1);
-#endif
-
RX_MATCH_UTF8_set(prog, do_utf8);
minlen = prog->minlen;
@@ -1864,14 +1853,11 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
}
DEBUG_EXECUTE_r({
- const char * const s0 = UTF
- ? pv_uni_display(dsv0, (U8*)prog->precomp, prog->prelen, 60,
- UNI_DISPLAY_REGEX)
- : prog->precomp;
- const int len0 = UTF ? (int)SvCUR(dsv0) : prog->prelen;
- const char * const s1 = do_utf8 ? sv_uni_display(dsv1, sv, 60,
- UNI_DISPLAY_REGEX) : startpos;
- const int len1 = do_utf8 ? (int)SvCUR(dsv1) : strend - startpos;
+ 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,
@@ -2076,24 +2062,17 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
}
DEBUG_EXECUTE_r({
SV * const prop = sv_newmortal();
- const char *s0;
- const char *s1;
- int len0;
- int len1;
-
regprop(prog, prop, c);
- s0 = UTF ?
- pv_uni_display(dsv0, (U8*)SvPVX_const(prop), SvCUR(prop), 60,
- UNI_DISPLAY_REGEX) :
- SvPVX_const(prop);
- len0 = UTF ? SvCUR(dsv0) : SvCUR(prop);
- s1 = UTF ?
- sv_uni_display(dsv1, sv, 60, UNI_DISPLAY_REGEX) : s;
- len1 = UTF ? (int)SvCUR(dsv1) : strend - s;
- PerlIO_printf(Perl_debug_log,
- "Matching stclass \"%*.*s\" against \"%*.*s\" (%d chars)\n",
- len0, len0, s0,
- len1, len1, s1, (int)(strend - s));
+ {
+ 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);
+ PerlIO_printf(Perl_debug_log,
+ "Matching stclass \"%*.*s\" against \"%*.*s\" (%d chars)\n",
+ len0, len0, s0,
+ len1, len1, s1, (int)(strend - s));
+ }
});
if (find_byclass(prog, c, s, strend, &reginfo))
goto got_it;
@@ -2648,28 +2627,17 @@ S_dump_exec_pos(pTHX_ const char *locinput, const regnode *scan, const bool do_u
pref0_len = pref_len;
{
const int is_uni = (do_utf8 && OP(scan) != CANY) ? 1 : 0;
- const char * const s0 = is_uni ?
- pv_uni_display(PERL_DEBUG_PAD(0), (U8*)(locinput - pref_len),
- pref0_len, 60, UNI_DISPLAY_REGEX) :
- pv_escape(PERL_DEBUG_PAD(0), (locinput - pref_len),
- pref0_len, 60, 0);
-
- const int len0 = strlen(s0);
- const char * const s1 = is_uni ?
- pv_uni_display(PERL_DEBUG_PAD(1),
- (U8*)(locinput - pref_len + pref0_len),
- pref_len - pref0_len, 60, UNI_DISPLAY_REGEX) :
- pv_escape(PERL_DEBUG_PAD(1),
+
+ RE_PV_DISPLAY_DECL(s0,len0,is_uni,PERL_DEBUG_PAD(0),
+ (locinput - pref_len),pref0_len, 60);
+
+ RE_PV_DISPLAY_DECL(s1,len1,is_uni,PERL_DEBUG_PAD(1),
(locinput - pref_len + pref0_len),
- pref_len - pref0_len, 60, 0);
-
- const int len1 = (int)strlen(s1);
- const char * const s2 = is_uni ?
- pv_uni_display(PERL_DEBUG_PAD(2), (U8*)locinput,
- PL_regeol - locinput, 60, UNI_DISPLAY_REGEX) :
- pv_escape(PERL_DEBUG_PAD(2), locinput,
- PL_regeol - locinput, 60, 0);
- const int len2 = (int)strlen(s2);
+ pref_len - pref0_len, 60);
+
+ RE_PV_DISPLAY_DECL(s2,len2,is_uni,PERL_DEBUG_PAD(2),
+ locinput, PL_regeol - locinput, 60);
+
PerlIO_printf(Perl_debug_log,
"%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|",
(IV)(locinput - PL_bostr),
Please sign in to comment.
Something went wrong with that request. Please try again.