From: Gurusamy Sarathy <gsar@cpan.org>
Date: Wed, 5 Aug 1998 02:29:46 +0000 (+0000)
Subject: back out change#1703 that break bincompat with PERL_OBJECT and
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=afe2cf94ca69dfa43c28629844e3530526559af4;p=p5sagit%2Fp5-mst-13.2.git

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
---

diff --git a/ext/re/re.pm b/ext/re/re.pm
index 1c225e3..7cea77d 100644
--- a/ext/re/re.pm
+++ b/ext/re/re.pm
@@ -84,12 +84,16 @@ sub setcolor {
   require Term::Cap;
 
   my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
-  my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue';
+  my $props = $ENV{PERL_RE_TC} || 'md,me,so,se'; # can use us/ue later
   my @props = split /,/, $props;
 
 
-  $ENV{PERL_RE_COLORS} = join "\t", map {$terminal->Tputs($_,1)} @props;
+  $ENV{TERMCAP_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/regcomp.c b/regcomp.c
index dceb5b7..f2f51a4 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)
diff --git a/regexec.c b/regexec.c
index e052912..f8c5e7e 100644
--- a/regexec.c
+++ b/regexec.c
@@ -318,14 +318,11 @@ regexec_flags(register regexp *prog, char *stringarg, register char *strend,
 
     DEBUG_r(
 	PerlIO_printf(Perl_debug_log, 
-		      "%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],
+		      "Matching `%.60s%s' against `%.*s%s'\n",
+		      prog->precomp, 
 		      (strlen(prog->precomp) > 60 ? "..." : ""),
-		      PL_colors[0], 
 		      (strend - startpos > 60 ? 60 : strend - startpos),
-		      startpos, PL_colors[1],
+		      startpos, 
 		      (strend - startpos > 60 ? "..." : ""))
 	);
 
@@ -797,21 +794,15 @@ 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%.*s%s>%*s|%3d:%*s%s\n",
+			  "%4i <%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n",
 			  locinput - PL_bostr, 
-			  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],
+			  PL_colors[2], pref_len, locinput - pref_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 3fa4c06..4ca3ccb 100644
--- 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[6],	char *)		/* from regcomp.c */
+PERLVAR(Tcolors[4],	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. */