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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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