为什么 Devel::LeakTrace 会泄漏内存？

似乎内存泄漏比valgrind报告的还要多。每次创建新的 SV 时，Devel::LeakTrace将当前文件名和行号记录在一个名为when的16 字节结构中：

typedef struct {
    char *file;
    int line;
} when;

这些块在分配线＃80有malloc()，但似乎它永远不会释放这些块。所以创建的标量越多，内存泄漏就越多。

一些背景资料

该模块尝试从END{}移相器确定泄漏的 SV 。此时，所有分配的 SV 都应该超出主程序的范围，并且它们的引用计数减少到零，这应该会销毁它们。但是，如果由于某种原因引用计数没有减少到零，标量将不会被销毁并从 perl 的内部内存管理池中释放。在这种情况下，标量被认为是模块泄漏的。

请注意，这与从由 malloc() 处理的操作系统内存池中看到的内存泄漏不同。当 perl 退出时，它仍会将任何泄漏的标量（从其内部内存池）释放回系统内存池。

这意味着该模块不是为了检测泄漏的系统内存。为此，我们可以使用 eg valgrind。

该模块挂钩到 perl runops 循环中，对于每个类型的 OP，OP_NEXTSTATE它将扫描所有arena和所有 SV，以寻找新的 SV（即：自上一个 SV 以来引入的 SV OP_NEXTSTATE）。

对于p.pl我问题中的这个示例程序，我计算了 31 个竞技场，每个竞技场包含 71 个 SV 的空间。几乎所有这些 SV 在运行时都在使用中（大约 2150 个）。该模块将这些 SV 中的每一个保存在一个哈希中used，其键等于 SV 的地址，值等于when分配标量的块（见上文）。对于每个OP_NEXTSTATE，它然后可以扫描所有 SV 并检查是否有一些不存在于used哈希中。

该used散列是不是一个Perl哈希（我想这是为了避免与分配的SV任何冲突，该模块试图跟踪），而不是模块使用GLib哈希表。

修补

为了跟踪分配的when块，我使用了一个名为when_hash. 然后在模块打印泄漏的标量后，when可以通过查找when_hash.

我还发现该模块没有释放used-hash。据我所知，它应该调用 glibg_hash_table_destroy()以将其从END{}块中释放。这是补丁：

LeakTrace.xs（已修补）：

#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 */
}

测试补丁

$ 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)