From 04932ac8f7d72810cce59c52976ab33010e88b99 Mon Sep 17 00:00:00 2001 From: Dave Mitchell Date: Fri, 9 Mar 2001 13:49:31 +0000 Subject: [PATCH] Re: [ PATCH perl@8956 ] new debug option -DR shows ref counts Message-Id: <200103091349.NAA16617@tiree.fdgroup.co.uk> p4raw-id: //depot/perl@9087 --- dump.c | 5 +++++ perl.c | 3 ++- perl.h | 7 ++++++- pod/perlrun.pod | 1 + 4 files changed, 14 insertions(+), 2 deletions(-) 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 file in the Perl source distribution -- 2.7.4