warn on C<my($foo,$foo)>

[p5sagit/p5-mst-13.2.git] / regcomp.c

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)