diff options
| -rw-r--r-- | ext/re/re.pm | 8 | ||||
| -rw-r--r-- | pod/perlre.pod | 2 | ||||
| -rw-r--r-- | regcomp.c | 54 | ||||
| -rw-r--r-- | regexec.c | 19 | ||||
| -rw-r--r-- | thrdvar.h | 2 |
5 files changed, 44 insertions, 41 deletions
diff --git a/ext/re/re.pm b/ext/re/re.pm index 7cea77dd42..1c225e3a7c 100644 --- a/ext/re/re.pm +++ b/ext/re/re.pm @@ -84,16 +84,12 @@ sub setcolor { require Term::Cap; my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning. - my $props = $ENV{PERL_RE_TC} || 'md,me,so,se'; # can use us/ue later + my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue'; my @props = split /,/, $props; - $ENV{TERMCAP_COLORS} = join "\t", map {$terminal->Tputs($_,1)} @props; + $ENV{PERL_RE_COLORS} = join "\t", map {$terminal->Tputs($_,1)} @props; }; - - not defined $ENV{TERMCAP_COLORS} or ($ENV{TERMCAP_COLORS} =~ tr/\t/\t/) >= 4 - or not defined $ENV{PERL_RE_TC} - or die "Not enough fields in \$ENV{PERL_RE_TC}=`$ENV{PERL_RE_TC}'"; } sub bits { diff --git a/pod/perlre.pod b/pod/perlre.pod index 6ecb7ad12a..d3d4500ce4 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -485,7 +485,7 @@ the time when used on a similar string with 1000000 C<a>s. Be aware, however, that this pattern currently triggers a warning message under B<-w> saying it C<"matches the null string many times">): -On simple groups, such as the pattern C<(?> [^()]+ )>, a comparable +On simple groups, such as the pattern C<(?E<gt> [^()]+ )>, a comparable effect may be achieved by negative lookahead, as in C<[^()]+ (?! [^()] )>. This was only 4 times slower on a string with 1000000 C<a>s. @@ -798,8 +798,32 @@ pregcomp(char *exp, char *xend, PMOP *pm) PL_reg_flags = 0; PL_regprecomp = savepvn(exp, xend - exp); - DEBUG_r(PerlIO_printf(Perl_debug_log, "compiling RE `%*s'\n", - xend - exp, PL_regprecomp)); + DEBUG_r( + if (!PL_colorset) { + int i = 0; + char *s = PerlEnv_getenv("PERL_RE_COLORS"); + + if (s) { + PL_colors[0] = s = savepv(s); + while (++i < 6) { + s = strchr(s, '\t'); + if (s) { + *s = '\0'; + PL_colors[i] = ++s; + } + else + PL_colors[i] = ""; + } + } else { + while (i < 6) + PL_colors[i++] = ""; + } + PL_colorset = 1; + } + ); + DEBUG_r(PerlIO_printf(Perl_debug_log, "%sCompiling%s RE `%s%*s%s'\n", + PL_colors[4],PL_colors[5],PL_colors[0], + xend - exp, PL_regprecomp, PL_colors[1])); PL_regflags = pm->op_pmflags; PL_regsawback = 0; @@ -823,32 +847,6 @@ pregcomp(char *exp, char *xend, PMOP *pm) } DEBUG_r(PerlIO_printf(Perl_debug_log, "size %d ", PL_regsize)); - DEBUG_r( - if (!PL_colorset) { - int i = 0; - char *s = PerlEnv_getenv("TERMCAP_COLORS"); - - PL_colorset = 1; - if (s) { - PL_colors[0] = s = savepv(s); - while (++i < 4) { - s = strchr(s, '\t'); - if (!s) - FAIL("Not enough TABs in TERMCAP_COLORS"); - *s = '\0'; - PL_colors[i] = ++s; - } - } - else { - while (i < 4) - PL_colors[i++] = ""; - } - /* Reset colors: */ - PerlIO_printf(Perl_debug_log, "%s%s%s%s", - PL_colors[0],PL_colors[1],PL_colors[2],PL_colors[3]); - } - ); - /* Small enough for pointer-storage convention? If extralen==0, this means that we will not need long jumps. */ if (PL_regsize >= 0x10000L && PL_extralen) @@ -386,11 +386,14 @@ regexec_flags(register regexp *prog, char *stringarg, register char *strend, DEBUG_r( PerlIO_printf(Perl_debug_log, - "Matching `%.60s%s' against `%.*s%s'\n", - prog->precomp, + "%sMatching%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], (strend - startpos > 60 ? 60 : strend - startpos), - startpos, + startpos, PL_colors[1], (strend - startpos > 60 ? "..." : "")) ); @@ -1101,15 +1104,21 @@ regmatch(regnode *prog) int l = (PL_regeol - locinput > taill ? taill : PL_regeol - locinput); int pref_len = (locinput - PL_bostr > (5 + taill) - l ? (5 + taill) - l : locinput - PL_bostr); + int pref0_len = pref_len - (locinput - PL_reginput); if (l + pref_len < (5 + taill) && l < PL_regeol - locinput) l = ( PL_regeol - locinput > (5 + taill) - pref_len ? (5 + taill) - pref_len : PL_regeol - locinput); + if (pref0_len < 0) + pref0_len = 0; regprop(prop, scan); PerlIO_printf(Perl_debug_log, - "%4i <%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n", + "%4i <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n", locinput - PL_bostr, - PL_colors[2], pref_len, locinput - pref_len, PL_colors[3], + 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, @@ -133,7 +133,7 @@ PERLVAR(Tseen_evals, I32) /* from regcomp.c */ PERLVAR(Tregcomp_rx, regexp *) /* from regcomp.c */ PERLVAR(Textralen, I32) /* from regcomp.c */ PERLVAR(Tcolorset, int) /* from regcomp.c */ -PERLVAR(Tcolors[4], char *) /* from regcomp.c */ +PERLVAR(Tcolors[6], char *) /* from regcomp.c */ PERLVAR(Treginput, char *) /* String-input pointer. */ PERLVAR(Tregbol, char *) /* Beginning of input, for ^ check. */ PERLVAR(Tregeol, char *) /* End of input, for $ check. */ |