From: Perl 5 Porters <perl5-porters@africa.nicoh.com>
Date: Tue, 18 Jun 1996 07:10:19 +0000 (+0000)
Subject: Allow redirection of debug messages
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fd181c75661f7c3d766abc506c3ae2f11670bbaf;p=p5sagit%2Fp5-mst-13.2.git

Allow redirection of debug messages
---

diff --git a/regcomp.c b/regcomp.c
index d120eb7..1bc1b2d 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -244,7 +244,7 @@ PMOP* pm;
 	if (sawplus && (!sawopen || !regsawback))
 	    r->reganch |= ROPT_SKIP;	/* x+ must match 1st of run */
 
-	DEBUG_r(fprintf(stderr,"first %d next %d offset %d\n",
+	DEBUG_r(fprintf(Perl_debug_log,"first %d next %d offset %d\n",
 	   OP(first), OP(NEXTOPER(first)), first - scan));
 	/*
 	* If there's something expensive in the r.e., find the
@@ -1432,7 +1432,7 @@ register char *s;
 #ifdef DEBUGGING
 
 /*
- - regdump - dump a regexp onto stderr in vaguely comprehensible form
+ - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
  */
 void
 regdump(r)
@@ -1450,13 +1450,13 @@ regexp *r;
 	    s++;
 #endif
 	op = OP(s);
-	fprintf(stderr,"%2d%s", s-r->program, regprop(s));	/* Where, what. */
+	fprintf(Perl_debug_log,"%2d%s", s-r->program, regprop(s));	/* Where, what. */
 	next = regnext(s);
 	s += regarglen[(U8)op];
 	if (next == NULL)		/* Next ptr. */
-	    fprintf(stderr,"(0)");
+	    fprintf(Perl_debug_log,"(0)");
 	else 
-	    fprintf(stderr,"(%d)", (s-r->program)+(next-s));
+	    fprintf(Perl_debug_log,"(%d)", (s-r->program)+(next-s));
 	s += 3;
 	if (op == ANYOF) {
 	    s += 32;
@@ -1464,34 +1464,34 @@ regexp *r;
 	if (op == EXACTLY) {
 	    /* Literal string, where present. */
 	    s++;
-	    (void)putc(' ', stderr);
-	    (void)putc('<', stderr);
+	    (void)putc(' ', Perl_debug_log);
+	    (void)putc('<', Perl_debug_log);
 	    while (*s != '\0') {
-		(void)putc(*s, stderr);
+		(void)putc(*s, Perl_debug_log);
 		s++;
 	    }
-	    (void)putc('>', stderr);
+	    (void)putc('>', Perl_debug_log);
 	    s++;
 	}
-	(void)putc('\n', stderr);
+	(void)putc('\n', Perl_debug_log);
     }
 
     /* Header fields of interest. */
     if (r->regstart)
-	fprintf(stderr,"start `%s' ", SvPVX(r->regstart));
+	fprintf(Perl_debug_log,"start `%s' ", SvPVX(r->regstart));
     if (r->regstclass)
-	fprintf(stderr,"stclass `%s' ", regprop(r->regstclass));
+	fprintf(Perl_debug_log,"stclass `%s' ", regprop(r->regstclass));
     if (r->reganch & ROPT_ANCH)
-	fprintf(stderr,"anchored ");
+	fprintf(Perl_debug_log,"anchored ");
     if (r->reganch & ROPT_SKIP)
-	fprintf(stderr,"plus ");
+	fprintf(Perl_debug_log,"plus ");
     if (r->reganch & ROPT_IMPLICIT)
-	fprintf(stderr,"implicit ");
+	fprintf(Perl_debug_log,"implicit ");
     if (r->regmust != NULL)
-	fprintf(stderr,"must have \"%s\" back %ld ", SvPVX(r->regmust),
+	fprintf(Perl_debug_log,"must have \"%s\" back %ld ", SvPVX(r->regmust),
 	 (long) r->regback);
-    fprintf(stderr, "minlen %ld ", (long) r->minlen);
-    fprintf(stderr,"\n");
+    fprintf(Perl_debug_log, "minlen %ld ", (long) r->minlen);
+    fprintf(Perl_debug_log,"\n");
 }
 
 /*
diff --git a/regexec.c b/regexec.c
index 6a29d7f..818d9dc 100644
--- a/regexec.c
+++ b/regexec.c
@@ -590,7 +590,7 @@ char *prog;
 #define sayNO goto no
 #define saySAME(x) if (x) goto yes; else goto no
 	if (regnarrate) {
-	    fprintf(stderr, "%*s%2d%-8.8s\t<%.10s>\n", regindent*2, "",
+	    fprintf(Perl_debug_log, "%*s%2d%-8.8s\t<%.10s>\n", regindent*2, "",
 		scan - regprogram, regprop(scan), locinput);
 	}
 #else
@@ -806,7 +806,7 @@ char *prog;
 
 #ifdef DEBUGGING
 		if (regnarrate)
-		    fprintf(stderr, "%*s  %d  %lx\n", regindent*2, "",
+		    fprintf(Perl_debug_log, "%*s  %d  %lx\n", regindent*2, "",
 			n, (long)cc);
 #endif
 
diff --git a/run.c b/run.c
index 7c09f8f..e168611 100644
--- a/run.c
+++ b/run.c
@@ -47,7 +47,7 @@ runops() {
     do {
 	if (debug) {
 	    if (watchaddr != 0 && *watchaddr != watchok)
-		fprintf(stderr, "WARNING: %lx changed from %lx to %lx\n",
+		fprintf(Perl_debug_log, "WARNING: %lx changed from %lx to %lx\n",
 		    (long)watchaddr, (long)watchok, (long)*watchaddr);
 	    DEBUG_s(debstack());
 	    DEBUG_t(debop(op));
@@ -65,23 +65,23 @@ OP *op;
     deb("%s", op_name[op->op_type]);
     switch (op->op_type) {
     case OP_CONST:
-	fprintf(stderr, "(%s)", SvPEEK(cSVOP->op_sv));
+	fprintf(Perl_debug_log, "(%s)", SvPEEK(cSVOP->op_sv));
 	break;
     case OP_GVSV:
     case OP_GV:
 	if (cGVOP->op_gv) {
 	    sv = NEWSV(0,0);
 	    gv_fullname(sv, cGVOP->op_gv);
-	    fprintf(stderr, "(%s)", SvPV(sv, na));
+	    fprintf(Perl_debug_log, "(%s)", SvPV(sv, na));
 	    SvREFCNT_dec(sv);
 	}
 	else
-	    fprintf(stderr, "(NULL)");
+	    fprintf(Perl_debug_log, "(NULL)");
 	break;
     default:
 	break;
     }
-    fprintf(stderr, "\n");
+    fprintf(Perl_debug_log, "\n");
     return 0;
 }
 
@@ -91,7 +91,7 @@ char **addr;
 {
     watchaddr = addr;
     watchok = *addr;
-    fprintf(stderr, "WATCHING, %lx is currently %lx\n",
+    fprintf(Perl_debug_log, "WATCHING, %lx is currently %lx\n",
 	(long)watchaddr, (long)watchok);
 }
 
@@ -112,7 +112,7 @@ debprofdump()
 	return;
     for (i = 0; i < MAXO; i++) {
 	if (profiledata[i])
-	    fprintf(stderr, "%d\t%lu\n", i, profiledata[i]);
+	    fprintf(Perl_debug_log, "%d\t%lu\n", i, profiledata[i]);
     }
 }