diff options
| author | Dave Mitchell <davem@fdisolutions.com> | 2001-03-09 13:49:31 +0000 |
|---|---|---|
| committer | Jarkko Hietaniemi <jhi@iki.fi> | 2001-03-09 14:38:56 +0000 |
| commit | 04932ac8f7d72810cce59c52976ab33010e88b99 (patch) | |
| tree | bc6507fa14063a22f27503c74bc21bfb9ed56af1 | |
| parent | 1dfe7606714789cb685cd524877388fe1e9008b4 (diff) | |
| download | perl-04932ac8f7d72810cce59c52976ab33010e88b99.tar.gz | |
Re: [ PATCH perl@8956 ] new debug option -DR shows ref counts
Message-Id: <200103091349.NAA16617@tiree.fdgroup.co.uk>
p4raw-id: //depot/perl@9087
| -rw-r--r-- | dump.c | 5 | ||||
| -rw-r--r-- | perl.c | 3 | ||||
| -rw-r--r-- | perl.h | 7 | ||||
| -rw-r--r-- | pod/perlrun.pod | 1 |
4 files changed, 14 insertions, 2 deletions
@@ -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) { @@ -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++) @@ -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 4a4c957a50..aa2f06d0e2 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 |