DEBUG_LEAKING_SCALARS: add sv_debug_parent

Rather than just recording whether an SV was cloned (sv->sv_debug_cloned),
record the address of the SV we were cloned from.

diff --git a/dump.c b/dump.c
index 76f276e..2acc7e1 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1626,12 +1626,12 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 
 #ifdef DEBUG_LEAKING_SCALARS
     Perl_dump_indent(aTHX_ level, file,
-       "ALLOCATED at %s:%d %s %s%s; serial %"UVuf"\n",
+       "ALLOCATED at %s:%d %s %s (parent 0x%"UVxf"); serial %"UVuf"\n",
        sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
        sv->sv_debug_line,
        sv->sv_debug_inpad ? "for" : "by",
        sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
-       sv->sv_debug_cloned ? " (cloned)" : "",
+       PTR2UV(sv->sv_debug_parent),
        sv->sv_debug_serial
     );
 #endif

diff --git a/perl.c b/perl.c
index 404372c..985ddf3 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1164,7 +1164,8 @@ perl_destruct(pTHXx)
                    PerlIO_printf(Perl_debug_log, "leaked: sv=0x%p"
                        " flags=0x%"UVxf
                        " refcnt=%"UVuf pTHX__FORMAT "\n"
-                       "\tallocated at %s:%d %s %s%s; serial %"UVuf"\n",
+                       "\tallocated at %s:%d %s %s (parent 0x%"UVxf");"
+                       "serial %"UVuf"\n",
                        (void*)sv, (UV)sv->sv_flags, (UV)sv->sv_refcnt
                        pTHX__VALUE,
                        sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
@@ -1172,7 +1173,7 @@ perl_destruct(pTHXx)
                        sv->sv_debug_inpad ? "for" : "by",
                        sv->sv_debug_optype ?
                            PL_op_name[sv->sv_debug_optype]: "(none)",
-                       sv->sv_debug_cloned ? " (cloned)" : "",
+                       PTR2UV(sv->sv_debug_parent),
                        sv->sv_debug_serial
                    );
 #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP

diff --git a/sv.c b/sv.c
index c95f9ed..ca61fd8 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -294,7 +294,7 @@ S_new_SV(pTHX_ const char *file, int line, const char *func)
                    : 0
            );
     sv->sv_debug_inpad = 0;
-    sv->sv_debug_cloned = 0;
+    sv->sv_debug_parent = NULL;
     sv->sv_debug_file = PL_curcop ? savepv(CopFILE(PL_curcop)): NULL;
 
     sv->sv_debug_serial = PL_sv_serial++;
@@ -11168,7 +11168,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
     dstr->sv_debug_optype = sstr->sv_debug_optype;
     dstr->sv_debug_line = sstr->sv_debug_line;
     dstr->sv_debug_inpad = sstr->sv_debug_inpad;
-    dstr->sv_debug_cloned = 1;
+    dstr->sv_debug_parent = (SV*)sstr;
     dstr->sv_debug_file = savepv(sstr->sv_debug_file);
 #endif
 

diff --git a/sv.h b/sv.h
index bc75d1e..a49954d 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -116,10 +116,10 @@ struct STRUCT_SV {                /* struct sv { */
 #ifdef DEBUG_LEAKING_SCALARS
     PERL_BITFIELD32 sv_debug_optype:9; /* the type of OP that allocated us */
     PERL_BITFIELD32 sv_debug_inpad:1;  /* was allocated in a pad for an OP */
-    PERL_BITFIELD32 sv_debug_cloned:1; /* was cloned for an ithread */
     PERL_BITFIELD32 sv_debug_line:16;  /* the line where we were allocated */
     U32                    sv_debug_serial;    /* serial number of sv allocation   */
-    char *     sv_debug_file;          /* the file where we were allocated */
+    char *         sv_debug_file;      /* the file where we were allocated */
+    SV *           sv_debug_parent;    /* what we were cloned from (ithreads)*/
 #endif
 };