Why is Devel::LeakTrace leaking memory?

Question

I am trying to learn more about how to detect memory leaks in Perl. I have this program:

p.pl:

#! /usr/bin/env perl

use Devel::LeakTrace;
my $foo;
$foo = \$foo;

Output:

leaked SV(0xac2df8e0) from ./p.pl line 5
leaked SV(0xac2df288) from ./p.pl line 5

Why is this leaking two scalars (and not just a single)?

Then I run it through valgrind. First I created a debugging version of perl:

$ perlbrew install perl-5.30.0 --as=5.30.0-D3L -DDEBUGGING \
  -Doptimize=-g3 -Accflags="-DDEBUG_LEAKING_SCALARS"
$ perlbrew use 5.30.0-D3L
$ cpanm Devel::LeakTrace

Then I ran valgrind setting PERL_DESTRUCT_LEVEL=2 as recommended in perlhacktips:

$  PERL_DESTRUCT_LEVEL=2 valgrind --leak-check=yes perl p.pl
==12479== Memcheck, a memory error detector
==12479== Copyright (C) 2002-2017, and GNU GPL'd, by Julian Seward et al.
==12479== Using Valgrind-3.14.0 and LibVEX; rerun with -h for copyright info
==12479== Command: perl p.pl
==12479== 
leaked SV(0x4c27320) from p.pl line 5
leaked SV(0x4c26cc8) from p.pl line 5
==12479== 
==12479== HEAP SUMMARY:
==12479==     in use at exit: 105,396 bytes in 26 blocks
==12479==   total heap usage: 14,005 allocs, 13,979 frees, 3,011,508 bytes allocated
==12479== 
==12479== 16 bytes in 1 blocks are definitely lost in loss record 5 of 21
==12479==    at 0x483874F: malloc (in /usr/lib/x86_64-linux-gnu/valgrind/vgpreload_memcheck-amd64-linux.so)
==12479==    by 0x484851A: note_changes (LeakTrace.xs:80)
==12479==    by 0x48488E3: XS_Devel__LeakTrace_hook_runops (LeakTrace.xs:126)
==12479==    by 0x32F0A2: Perl_pp_entersub (pp_hot.c:5237)
==12479==    by 0x2C0C50: Perl_runops_debug (dump.c:2537)
==12479==    by 0x1A2FD9: Perl_call_sv (perl.c:3043)
==12479==    by 0x1ACEE3: Perl_call_list (perl.c:5084)
==12479==    by 0x181233: S_process_special_blocks (op.c:10471)
==12479==    by 0x180989: Perl_newATTRSUB_x (op.c:10397)
==12479==    by 0x220D6C: Perl_yyparse (perly.y:295)
==12479==    by 0x3EE46B: S_doeval_compile (pp_ctl.c:3502)
==12479==    by 0x3F4F87: S_require_file (pp_ctl.c:4322)
==12479== 
==12479== LEAK SUMMARY:
==12479==    definitely lost: 16 bytes in 1 blocks
==12479==    indirectly lost: 0 bytes in 0 blocks
==12479==      possibly lost: 0 bytes in 0 blocks
==12479==    still reachable: 105,380 bytes in 25 blocks
==12479==         suppressed: 0 bytes in 0 blocks
==12479== Reachable blocks (those to which a pointer was found) are not shown.
==12479== To see them, rerun with: --leak-check=full --show-leak-kinds=all
==12479== 
==12479== For counts of detected and suppressed errors, rerun with: -v
==12479== ERROR SUMMARY: 1 errors from 1 contexts (suppressed: 0 from 0)

so 16 bytes are lost. However, if I comment out the line use Devel::LeakTrace in p.pl and run valgrind again, the output is:

==12880== Memcheck, a memory error detector
==12880== Copyright (C) 2002-2017, and GNU GPL'd, by Julian Seward et al.
==12880== Using Valgrind-3.14.0 and LibVEX; rerun with -h for copyright info
==12880== Command: perl p.pl
==12880== 
==12880== 
==12880== HEAP SUMMARY:
==12880==     in use at exit: 0 bytes in 0 blocks
==12880==   total heap usage: 1,770 allocs, 1,770 frees, 244,188 bytes allocated
==12880== 
==12880== All heap blocks were freed -- no leaks are possible
==12880== 
==12880== For counts of detected and suppressed errors, rerun with: -v
==12880== ERROR SUMMARY: 0 errors from 0 contexts (suppressed: 0 from 0)

So the question is: Why is Devel::LeakTrace causing a memory leak?

Answer 1

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)