back out change#1703 that break bincompat with PERL_OBJECT and

MULTIPLICITY

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

p4raw-id: //depot/maint-5.005/perl@1735

1 files changed, 27 insertions, 26 deletions

diff --git a/regcomp.c b/regcomp.c
index dceb5b7bb8..f2f51a4420 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -730,32 +730,8 @@ pregcomp(char *exp, char *xend, PMOP *pm)
 	FAIL("NULL regexp argument");
 
     PL_regprecomp = savepvn(exp, xend - exp);
-    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]));
+    DEBUG_r(PerlIO_printf(Perl_debug_log, "compiling RE `%*s'\n",
+			  xend - exp, PL_regprecomp));
     PL_regflags = pm->op_pmflags;
     PL_regsawback = 0;
 
@@ -779,6 +755,31 @@ 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)