Why is Devel::LeakTrace leaking memory?
It seems like there are even more memory leaks than valgrind reported.
Each time a new SV is created, Devel::LeakTrace records the current file name and line number in a 16 bytes structure called when:
typedef struct {
char *file;
int line;
} when;
These blocks are allocated at line #80 with malloc() but it seems it never frees these blocks. So the more scalars are created, the more memory will leak.
Some background information
The module tries to determine leaked SVs from the END{} phaser. At this point all allocated SVs should have gone out of scope from the main program and had their reference count decreased to zero, which should destroy them. However, if for some reason the reference count is not decremented to zero, the scalar will not be destroyed and freed
from perl's internal memory management pool. In this case the scalar is considered as leaked by the module.
Note that this is not the same as leaked memory as seen from the operating systems memory pool handled by e.g. malloc(). When perl exits it will still free any leaked scalars (from its internal memory pool) back to the systems memory pool.
This means that the module is not meant to detect leaked system memory. For this, we can use e.g. valgrind.
The module hooks into the perl runops loop and for each OP that is of type OP_NEXTSTATE it will scan all arenas and all SVs in those for new SVs (that is: SVs that has been introduced since the previous OP_NEXTSTATE).
For this sample program p.pl in my question I counted 31 arenas, and each arena contained space for 71 SVs. Almost all of these SVs were in use during run time (approximately 2150 of them). The module keeps each of these SVs in a hash used with key equal to the address of the SV and value equal to the when block (see above) where the scalar was allocated. For each OP_NEXTSTATE, it can then scan all SVs and check if there are some that are not present in the used hash.
The used hash is not a perl hash ( I guess this was to avoid any conflicts with
the allocated SVs that the module tries to keep track of), instead the module uses GLib hash tables.
Patch
In order to keep track of the allocated when blocks, I used a new glib hash called when_hash. Then after the module had printed the leaked scalars, the when blocks could be freed by looking up all keys in the when_hash.
I also found that the module did not free the used-hash. As far as I can see it should be calling the glib g_hash_table_destroy() to release it from the END{} block. Here is the patch:
LeakTrace.xs (patched):
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <glib.h>
typedef struct {
char *file;
int line;
} when;
/* a few globals, never mind the mess for now */
GHashTable *used = NULL;
GHashTable *new_used = NULL;
/* cargo from Devel::Leak - wander the arena, see what SVs live */
typedef long used_proc _((void *,SV *,long));
/* PATCH: fix memory leaks */
/***************************/
GHashTable *when_hash = NULL; /* store the allocated when blocks here */
static int have_run_end_hook = 0; /* indicator to runops that we are done */
static runops_proc_t save_orig_run_ops; /* original runops function */
/* Called from END{}, i.e. from show_used() after having printed the leaks.
* Free memory allocated for the when blocks */
static
void
free_when_block(gpointer key, gpointer value, gpointer user_data) {
free(key);
}
static
void
do_cleanup() {
/* this line was missing from the original show_used() */
if (used) g_hash_table_destroy( used );
if (when_hash) g_hash_table_foreach( when_hash, free_when_block, NULL );
g_hash_table_destroy( when_hash );
PL_runops = save_orig_run_ops;
have_run_end_hook = 1;
}
/* END PATCH: fix memory leaks */
/*******************************/
static
long int
sv_apply_to_used(void *p, used_proc *proc, long n) {
SV *sva;
for (sva = PL_sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
SV *sv = sva + 1;
SV *svend = &sva[SvREFCNT(sva)];
while (sv < svend) {
if (SvTYPE(sv) != SVTYPEMASK) {
n = (*proc) (p, sv, n);
}
++sv;
}
}
return n;
}
/* end Devel::Leak cargo */
static
long
note_used(void *p, SV* sv, long n) {
when *old = NULL;
if (used && (old = g_hash_table_lookup( used, sv ))) {
g_hash_table_insert(new_used, sv, old);
return n;
}
g_hash_table_insert(new_used, sv, p);
return 1;
}
static
void
print_me(gpointer key, gpointer value, gpointer user_data) {
when *w = value;
char *type;
switch SvTYPE((SV*)key) {
case SVt_PVAV: type = "AV"; break;
case SVt_PVHV: type = "HV"; break;
case SVt_PVCV: type = "CV"; break;
case SVt_RV: type = "RV"; break;
case SVt_PVGV: type = "GV"; break;
default: type = "SV";
}
if (w->file) {
fprintf(stderr, "leaked %s(0x%x) from %s line %d\n",
type, key, w->file, w->line);
}
}
static
int
note_changes( char *file, int line ) {
static when *w = NULL;
int ret;
/* PATCH */
if (have_run_end_hook) return 0; /* do not enter after clean up is complete */
/* if (!w) w = malloc(sizeof(when)); */
if (!w) {
w = malloc(sizeof(when));
if (!when_hash) {
/* store pointer to allocated blocks here */
when_hash = g_hash_table_new( NULL, NULL );
}
g_hash_table_insert(when_hash, w, NULL); /* store address to w */
}
/* END PATCH */
w->line = line;
w->file = file;
new_used = g_hash_table_new( NULL, NULL );
if (sv_apply_to_used( w, note_used, 0 )) w = NULL;
if (used) g_hash_table_destroy( used );
used = new_used;
return ret;
}
/* Now this bit of cargo is a derived from Devel::Caller */
static
int
runops_leakcheck(pTHX) {
char *lastfile = 0;
int lastline = 0;
IV last_count = 0;
while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) {
PERL_ASYNC_CHECK();
if (PL_op->op_type == OP_NEXTSTATE) {
if (PL_sv_count != last_count) {
note_changes( lastfile, lastline );
last_count = PL_sv_count;
}
lastfile = CopFILE(cCOP);
lastline = CopLINE(cCOP);
}
}
note_changes( lastfile, lastline );
TAINT_NOT;
return 0;
}
MODULE = Devel::LeakTrace PACKAGE = Devel::LeakTrace
PROTOTYPES: ENABLE
void
hook_runops()
PPCODE:
{
note_changes(NULL, 0);
PL_runops = runops_leakcheck;
}
void
reset_counters()
PPCODE:
{
if (used) g_hash_table_destroy( used );
used = NULL;
note_changes(NULL, 0);
}
void
show_used()
CODE:
{
if (used) g_hash_table_foreach( used, print_me, NULL );
/* PATCH */
do_cleanup(); /* released allocated memory, restore original runops */
/* END PATCH */
}
Testing the patch
$ wget https://www.cpan.org/modules/by-module/Devel/Devel-LeakTrace-0.06.tar.gz
$ tar zxvf Devel-LeakTrace-0.06.tar.gz
$ cd Devel-LeakTrace-0.06
$ perlbrew use 5.30.0-D3L
# replace lib/Devel/LeakTrace.xs with my patch
$ perl Makefile.PL
$ make
$ make install # <- installs the patch
# cd to test folder, then
$ PERL_DESTRUCT_LEVEL=2 valgrind --leak-check=yes perl p.pl
==25019== Memcheck, a memory error detector
==25019== Copyright (C) 2002-2017, and GNU GPL'd, by Julian Seward et al.
==25019== Using Valgrind-3.14.0 and LibVEX; rerun with -h for copyright info
==25019== Command: perl p.pl
==25019==
leaked SV(0x4c26cd8) from p.pl line 5
leaked SV(0x4c27330) from p.pl line 5
==25019==
==25019== HEAP SUMMARY:
==25019== in use at exit: 23,324 bytes in 18 blocks
==25019== total heap usage: 13,968 allocs, 13,950 frees, 2,847,004 bytes allocated
==25019==
==25019== LEAK SUMMARY:
==25019== definitely lost: 0 bytes in 0 blocks
==25019== indirectly lost: 0 bytes in 0 blocks
==25019== possibly lost: 0 bytes in 0 blocks
==25019== still reachable: 23,324 bytes in 18 blocks
==25019== suppressed: 0 bytes in 0 blocks
==25019== Reachable blocks (those to which a pointer was found) are not shown.
==25019== To see them, rerun with: --leak-check=full --show-leak-kinds=all
==25019==
==25019== For counts of detected and suppressed errors, rerun with: -v
==25019== ERROR SUMMARY: 0 errors from 0 contexts (suppressed: 0 from 0)