re-introduce change#1703

p4raw-link: @1703 on //depot/maint-5.005/perl: af819cba4f44bf2074ec4808e403dedf8c3ce2b2

p4raw-id: //depot/perl@1825

diff --git a/ext/re/re.pm b/ext/re/re.pm
index 7cea77d..1c225e3 100644 (file)
--- 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 6ecb7ad..d3d4500 100644 (file)
--- 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.
 

diff --git a/regcomp.c b/regcomp.c
index 0782232..02b65d6 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -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)

diff --git a/regexec.c b/regexec.c
index 2dac18d..2bbe487 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -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,

diff --git a/thrdvar.h b/thrdvar.h
index c247dc4..958db6d 100644 (file)
--- a/thrdvar.h
+++ b/thrdvar.h
@@ -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. */