From: Dave Mitchell <davem@fdisolutions.com>
Date: Fri, 9 Mar 2001 13:49:31 +0000 (+0000)
Subject: Re: [ PATCH perl@8956 ] new debug option -DR shows ref counts
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=04932ac8f7d72810cce59c52976ab33010e88b99;p=p5sagit%2Fp5-mst-13.2.git

Re: [ PATCH perl@8956 ] new debug option -DR shows ref counts
Message-Id: <200103091349.NAA16617@tiree.fdgroup.co.uk>

p4raw-id: //depot/perl@9087
---

diff --git a/dump.c b/dump.c
index 6805729..be104d6 100644
--- a/dump.c
+++ b/dump.c
@@ -194,6 +194,11 @@ Perl_sv_peek(pTHX_ SV *sv)
 	sv_catpv(t, "(");
 	unref++;
     }
+    else if (DEBUG_R_TEST && SvREFCNT(sv) > 1) {
+	sv_catpvf(t, "<%u>", SvREFCNT(sv));
+    }
+
+
     if (SvROK(sv)) {
 	sv_catpv(t, "\\");
 	if (SvCUR(t) + unref > 10) {
diff --git a/perl.c b/perl.c
index 0c4d907..6568161 100644
--- a/perl.c
+++ b/perl.c
@@ -2126,7 +2126,8 @@ Perl_moreswitches(pTHX_ char *s)
 #ifdef DEBUGGING
 	forbid_setid("-D");
 	if (isALPHA(s[1])) {
-	    static char debopts[] = "psltocPmfrxuLHXDST";
+	    /* if adding extra options, remember to update DEBUG_MASK */
+	    static char debopts[] = "psltocPmfrxuLHXDSTR";
 	    char *d;
 
 	    for (s++; *s && (d = strchr(debopts,*s)); s++)
diff --git a/perl.h b/perl.h
index 66c6e4d..27cd66d 100644
--- a/perl.h
+++ b/perl.h
@@ -2150,7 +2150,8 @@ Gid_t getegid (void);
 #define DEBUG_D_FLAG		0x00008000 /*  32768 */
 #define DEBUG_S_FLAG		0x00010000 /*  65536 */
 #define DEBUG_T_FLAG		0x00020000 /* 131072 */
-#define DEBUG_MASK		0x0003FFFF /* mask of all the standard flags */
+#define DEBUG_R_FLAG		0x00040000 /* 262144 */
+#define DEBUG_MASK		0x0007FFFF /* mask of all the standard flags */
 
 #define DEBUG_DB_RECURSE_FLAG	0x40000000
 #define DEBUG_TOP_FLAG		0x80000000 /* XXX what's this for ??? */
@@ -2179,6 +2180,7 @@ Gid_t getegid (void);
 #  define DEBUG_D_TEST (PL_debug & DEBUG_D_FLAG)
 #  define DEBUG_S_TEST (PL_debug & DEBUG_S_FLAG)
 #  define DEBUG_T_TEST (PL_debug & DEBUG_T_FLAG)
+#  define DEBUG_R_TEST (PL_debug & DEBUG_R_FLAG)
 
 #  define DEB(a)     a
 #  define DEBUG(a)   if (PL_debug)   a
@@ -2217,6 +2219,7 @@ Gid_t getegid (void);
 #  endif
 
 #  define DEBUG_T(a) if (DEBUG_T_TEST) a
+#  define DEBUG_R(a) if (DEBUG_R_TEST) a
 
 #else /* DEBUGGING */
 
@@ -2238,6 +2241,7 @@ Gid_t getegid (void);
 #  define DEBUG_D_TEST (0)
 #  define DEBUG_S_TEST (0)
 #  define DEBUG_T_TEST (0)
+#  define DEBUG_R_TEST (0)
 
 #  define DEB(a)
 #  define DEBUG(a)
@@ -2259,6 +2263,7 @@ Gid_t getegid (void);
 #  define DEBUG_D(a)
 #  define DEBUG_S(a)
 #  define DEBUG_T(a)
+#  define DEBUG_R(a)
 #endif /* DEBUGGING */
 
 
diff --git a/pod/perlrun.pod b/pod/perlrun.pod
index 4a4c957..aa2f06d 100644
--- a/pod/perlrun.pod
+++ b/pod/perlrun.pod
@@ -323,6 +323,7 @@ equivalent to B<-Dtls>):
     32768  D  Cleaning up
     65536  S  Thread synchronization
    131072  T  Tokenising
+   262144  R  Include reference counts of dumped variables (eg when using -Ds)
 
 All these flags require B<-DDEBUGGING> when you compile the Perl
 executable.  See the F<INSTALL> file in the Perl source distribution