(perl #127380) only trace to $PERLIO_DEBUG if -Di is supplied

1 files changed, 58 insertions, 44 deletions

diff --git a/perlio.c b/perlio.c
index 11a66d077e..20c2fa3afa 100644
--- a/perlio.c
+++ b/perlio.c
@@ -351,6 +351,10 @@ PerlIO_debug(const char *fmt, ...)
     va_list ap;
     dSYS;
     va_start(ap, fmt);
+
+    if (!DEBUG_i_TEST)
+        return;
+
     if (!PL_perlio_debug_fd) {
 	if (!TAINTING_get &&
 	    PerlProc_getuid() == PerlProc_geteuid() &&
@@ -477,7 +481,7 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
 {
     if (PerlIOValid(f)) {
 	const PerlIO_funcs * const tab = PerlIOBase(f)->tab;
-	PerlIO_debug("fdupopen f=%p param=%p\n",(void*)f,(void*)param);
+	DEBUG_i( PerlIO_debug("fdupopen f=%p param=%p\n",(void*)f,(void*)param) );
 	if (tab && tab->Dup)
 	     return (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX), f, param, flags);
 	else {
@@ -586,7 +590,7 @@ PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param)
     PL_known_layers = PerlIO_clone_list(aTHX_ proto->Iknown_layers, param);
     PL_def_layerlist = PerlIO_clone_list(aTHX_ proto->Idef_layerlist, param);
     PerlIO_init_table(aTHX);
-    PerlIO_debug("Clone %p from %p\n",(void*)aTHX,(void*)proto);
+    DEBUG_i( PerlIO_debug("Clone %p from %p\n",(void*)aTHX,(void*)proto) );
     while ((f = *table)) {
 	    int i;
 	    table = (PerlIOl **) (f++);
@@ -610,7 +614,7 @@ PerlIO_destruct(pTHX)
     PerlIOl **table = &PL_perlio;
     PerlIOl *f;
 #ifdef USE_ITHREADS
-    PerlIO_debug("Destruct %p\n",(void*)aTHX);
+    DEBUG_i( PerlIO_debug("Destruct %p\n",(void*)aTHX) );
 #endif
     while ((f = *table)) {
 	int i;
@@ -620,7 +624,7 @@ PerlIO_destruct(pTHX)
 	    const PerlIOl *l;
 	    while ((l = *x)) {
 		if (l->tab && l->tab->kind & PERLIO_K_DESTRUCT) {
-		    PerlIO_debug("Destruct popping %s\n", l->tab->name);
+		    DEBUG_i( PerlIO_debug("Destruct popping %s\n", l->tab->name) );
 		    PerlIO_flush(x);
 		    PerlIO_pop(aTHX_ x);
 		}
@@ -639,8 +643,8 @@ PerlIO_pop(pTHX_ PerlIO *f)
     const PerlIOl *l = *f;
     VERIFY_HEAD(f);
     if (l) {
-	PerlIO_debug("PerlIO_pop f=%p %s\n", (void*)f,
-			    l->tab ? l->tab->name : "(Null)");
+	DEBUG_i( PerlIO_debug("PerlIO_pop f=%p %s\n", (void*)f,
+                              l->tab ? l->tab->name : "(Null)") );
 	if (l->tab && l->tab->Popped) {
 	    /*
 	     * If popped returns non-zero do not free its layer structure
@@ -713,7 +717,7 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
 	PerlIO_funcs * const f = PL_known_layers->array[i].funcs;
         const STRLEN this_len = strlen(f->name);
         if (this_len == len && memEQ(f->name, name, len)) {
-	    PerlIO_debug("%.*s => %p\n", (int) len, name, (void*)f);
+	    DEBUG_i( PerlIO_debug("%.*s => %p\n", (int) len, name, (void*)f) );
 	    return f;
 	}
     }
@@ -741,7 +745,7 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
 	    return PerlIO_find_layer(aTHX_ name, len, 0);
 	}
     }
-    PerlIO_debug("Cannot find %.*s\n", (int) len, name);
+    DEBUG_i( PerlIO_debug("Cannot find %.*s\n", (int) len, name) );
     return NULL;
 }
 
@@ -844,8 +848,9 @@ XS(XS_PerlIO__Layer__NoWarnings)
      */
     dXSARGS;
     PERL_UNUSED_ARG(cv);
-    if (items)
-    	PerlIO_debug("warning:%s\n",SvPV_nolen_const(ST(0)));
+    DEBUG_i(
+        if (items)
+            PerlIO_debug("warning:%s\n",SvPV_nolen_const(ST(0))) );
     XSRETURN(0);
 }
 
@@ -874,7 +879,7 @@ PerlIO_define_layer(pTHX_ PerlIO_funcs *tab)
     if (!PL_known_layers)
 	PL_known_layers = PerlIO_list_alloc(aTHX);
     PerlIO_list_push(aTHX_ PL_known_layers, tab, NULL);
-    PerlIO_debug("define %s %p\n", tab->name, (void*)tab);
+    DEBUG_i( PerlIO_debug("define %s %p\n", tab->name, (void*)tab) );
 }
 
 int
@@ -979,7 +984,7 @@ PerlIO_default_buffer(pTHX_ PerlIO_list_t *av)
     if (PerlIO_stdio.Set_ptrcnt)
 	tab = &PerlIO_stdio;
 #endif
-    PerlIO_debug("Pushing %s\n", tab->name);
+    DEBUG_i( PerlIO_debug("Pushing %s\n", tab->name) );
     PerlIO_list_push(aTHX_ av, (PerlIO_funcs *)tab, &PL_sv_undef);
 }
 
@@ -993,8 +998,8 @@ PerlIO_funcs *
 PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, PerlIO_funcs *def)
 {
     if (n >= 0 && n < av->cur) {
-	PerlIO_debug("Layer %" IVdf " is %s\n", n,
-		     av->array[n].funcs->name);
+	DEBUG_i( PerlIO_debug("Layer %" IVdf " is %s\n", n,
+                              av->array[n].funcs->name) );
 	return av->array[n].funcs;
     }
     if (!def)
@@ -1145,9 +1150,9 @@ PerlIO_push(pTHX_ PerlIO *f, PERLIO_FUNCS_DECL(*tab), const char *mode, SV *arg)
 		l->tab = (PerlIO_funcs*) tab;
 		l->head = ((PerlIOl*)f)->head;
 		*f = l;
-		PerlIO_debug("PerlIO_push f=%p %s %s %p\n",
-			     (void*)f, tab->name,
-			     (mode) ? mode : "(Null)", (void*)arg);
+		DEBUG_i( PerlIO_debug("PerlIO_push f=%p %s %s %p\n",
+                                      (void*)f, tab->name,
+                                      (mode) ? mode : "(Null)", (void*)arg) );
 		if (*l->tab->Pushed &&
 		    (*l->tab->Pushed)
 		      (aTHX_ f, mode, arg, (PerlIO_funcs*) tab) != 0) {
@@ -1161,8 +1166,8 @@ PerlIO_push(pTHX_ PerlIO *f, PERLIO_FUNCS_DECL(*tab), const char *mode, SV *arg)
     }
     else if (f) {
 	/* Pseudo-layer where push does its own stack adjust */
-	PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name,
-		     (mode) ? mode : "(Null)", (void*)arg);
+	DEBUG_i( PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name,
+                              (mode) ? mode : "(Null)", (void*)arg) );
 	if (tab->Pushed &&
 	    (*tab->Pushed) (aTHX_ f, mode, arg, (PerlIO_funcs*) tab) != 0) {
 	     return NULL;
@@ -1241,8 +1246,8 @@ PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 	    }
 	}
 	if (PerlIOValid(f)) {
-	    PerlIO_debug(":raw f=%p :%s\n", (void*)f,
-		PerlIOBase(f)->tab ? PerlIOBase(f)->tab->name : "(Null)");
+	    DEBUG_i( PerlIO_debug(":raw f=%p :%s\n", (void*)f,
+                         PerlIOBase(f)->tab ? PerlIOBase(f)->tab->name : "(Null)") );
 	    return 0;
 	}
     }
@@ -1294,10 +1299,11 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
 int
 PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names)
 {
-    PerlIO_debug("PerlIO_binmode f=%p %s %c %x %s\n", (void*)f,
-                 (PerlIOBase(f) && PerlIOBase(f)->tab) ?
-		       	PerlIOBase(f)->tab->name : "(Null)",
-                 iotype, mode, (names) ? names : "(Null)");
+    DEBUG_i(
+        PerlIO_debug("PerlIO_binmode f=%p %s %c %x %s\n", (void*)f,
+                     (PerlIOBase(f) && PerlIOBase(f)->tab) ?
+                     PerlIOBase(f)->tab->name : "(Null)",
+                     iotype, mode, (names) ? names : "(Null)") );
 
     if (names) {
 	/* Do not flush etc. if (e.g.) switching encodings.
@@ -1530,9 +1536,9 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 	    if (narg > 1 && !(tab->kind & PERLIO_K_MULTIARG)) {
 		Perl_croak(aTHX_ "More than one argument to open(,':%s')",tab->name);
 	    }
-	    PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n",
-			 tab->name, layers ? layers : "(Null)", mode, fd,
-			 imode, perm, (void*)f, narg, (void*)args);
+	    DEBUG_i( PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n",
+                                  tab->name, layers ? layers : "(Null)", mode, fd,
+                                  imode, perm, (void*)f, narg, (void*)args) );
 	    if (tab->Open)
 		 f = (*tab->Open) (aTHX_ tab, layera, n, mode, fd, imode, perm,
 				   f, narg, args);
@@ -1609,7 +1615,7 @@ Perl_PerlIO_flush(pTHX_ PerlIO *f)
 		 return 0; /* If no Flush defined, silently succeed. */
 	}
 	else {
-	    PerlIO_debug("Cannot flush f=%p\n", (void*)f);
+	    DEBUG_i( PerlIO_debug("Cannot flush f=%p\n", (void*)f) );
 	    SETERRNO(EBADF, SS_IVCHAN);
 	    return -1;
 	}
@@ -2001,9 +2007,11 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 	}
     }
 #if 0
+    DEBUG_i(
     PerlIO_debug("PerlIOBase_pushed f=%p %s %s fl=%08" UVxf " (%s)\n",
 		 (void*)f, PerlIOBase(f)->tab->name, (omode) ? omode : "(Null)",
 		 l->flags, PerlIO_modestr(f, temp));
+    );
 #endif
     return 0;
 }
@@ -2187,9 +2195,9 @@ PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
 	SV *arg = NULL;
 	char buf[8];
 	assert(self);
-	PerlIO_debug("PerlIOBase_dup %s f=%p o=%p param=%p\n",
-		     self->name,
-		     (void*)f, (void*)o, (void*)param);
+	DEBUG_i(PerlIO_debug("PerlIOBase_dup %s f=%p o=%p param=%p\n",
+                             self->name,
+                             (void*)f, (void*)o, (void*)param) );
 	if (self->Getarg)
 	  arg = (*self->Getarg)(aTHX_ o, param, flags);
 	f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
@@ -2216,8 +2224,8 @@ S_more_refcounted_fds(pTHX_ const int new_fd)
     PERL_UNUSED_CONTEXT;
 #endif
 
-    PerlIO_debug("More fds - old=%d, need %d, new=%d\n",
-		 old_max, new_fd, new_max);
+    DEBUG_i( PerlIO_debug("More fds - old=%d, need %d, new=%d\n",
+                          old_max, new_fd, new_max) );
 
     if (new_fd < old_max) {
 	return;
@@ -2239,9 +2247,9 @@ S_more_refcounted_fds(pTHX_ const int new_fd)
     PL_perlio_fd_refcnt_size = new_max;
     PL_perlio_fd_refcnt = new_array;
 
-    PerlIO_debug("Zeroing %p, %d\n",
-		 (void*)(new_array + old_max),
-		 new_max - old_max);
+    DEBUG_i( PerlIO_debug("Zeroing %p, %d\n",
+                          (void*)(new_array + old_max),
+                          new_max - old_max) );
 
     Zero(new_array + old_max, new_max - old_max, int);
 }
@@ -2273,8 +2281,8 @@ PerlIOUnix_refcnt_inc(int fd)
 	    Perl_croak(aTHX_ "refcnt_inc: fd %d: %d <= 0\n",
 		       fd, PL_perlio_fd_refcnt[fd]);
 	}
-	PerlIO_debug("refcnt_inc: fd %d refcnt=%d\n",
-		     fd, PL_perlio_fd_refcnt[fd]);
+	DEBUG_i( PerlIO_debug("refcnt_inc: fd %d refcnt=%d\n",
+                              fd, PL_perlio_fd_refcnt[fd]) );
 
 #ifdef USE_ITHREADS
 	MUTEX_UNLOCK(&PL_perlio_mutex);
@@ -2290,7 +2298,11 @@ PerlIOUnix_refcnt_dec(int fd)
 {
     int cnt = 0;
     if (fd >= 0) {
+#ifdef DEBUGGING
+        dTHX;
+#else
 	dVAR;
+#endif
 #ifdef USE_ITHREADS
 	MUTEX_LOCK(&PL_perlio_mutex);
 #endif
@@ -2305,7 +2317,7 @@ PerlIOUnix_refcnt_dec(int fd)
 		       fd, PL_perlio_fd_refcnt[fd]);
 	}
 	cnt = --PL_perlio_fd_refcnt[fd];
-	PerlIO_debug("refcnt_dec: fd %d refcnt=%d\n", fd, cnt);
+	DEBUG_i( PerlIO_debug("refcnt_dec: fd %d refcnt=%d\n", fd, cnt) );
 #ifdef USE_ITHREADS
 	MUTEX_UNLOCK(&PL_perlio_mutex);
 #endif
@@ -2352,9 +2364,9 @@ PerlIO_cleanup(pTHX)
 {
     int i;
 #ifdef USE_ITHREADS
-    PerlIO_debug("Cleanup layers for %p\n",(void*)aTHX);
+    DEBUG_i( PerlIO_debug("Cleanup layers for %p\n",(void*)aTHX) );
 #else
-    PerlIO_debug("Cleanup layers\n");
+    DEBUG_i( PerlIO_debug("Cleanup layers\n") );
 #endif
 
     /* Raise STDIN..STDERR refcount so we don't close them */
@@ -2557,11 +2569,11 @@ PerlIOUnix_setfd(pTHX_ PerlIO *f, int fd, int imode)
     Stat_t st;
     if (PerlLIO_fstat(fd, &st) == 0) {
 	if (!S_ISREG(st.st_mode)) {
-	    PerlIO_debug("%d is not regular file\n",fd);
+	    DEBUG_i( PerlIO_debug("%d is not regular file\n",fd) );
     	    PerlIOBase(f)->flags |= PERLIO_F_NOTREG;
 	}
 	else {
-	    PerlIO_debug("%d _is_ a regular file\n",fd);
+	    DEBUG_i( PerlIO_debug("%d _is_ a regular file\n",fd) );
 	}
     }
 #endif
@@ -4493,9 +4505,11 @@ PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
     PerlIOBase(f)->flags |= PERLIO_F_CRLF;
     code = PerlIOBuf_pushed(aTHX_ f, mode, arg, tab);
 #if 0
+    DEBUG_i(
     PerlIO_debug("PerlIOCrlf_pushed f=%p %s %s fl=%08" UVxf "\n",
 		 (void*)f, PerlIOBase(f)->tab->name, (mode) ? mode : "(Null)",
 		 PerlIOBase(f)->flags);
+    );
 #endif
     {
       /* If the old top layer is a CRLF layer, reactivate it (if