From 55ef9aae2276249f1bc9d3c71e11acb54457a14a Mon Sep 17 00:00:00 2001 From: Marcus Holland-Moritz Date: Mon, 6 Mar 2006 22:18:52 +0000 Subject: [PATCH] Don't free thread memory if PERL_DESTRUCT_LEVEL is set to a non-zero value as we're probably hunting memory leaks then p4raw-id: //depot/perl@27396 --- perl.c | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/perl.c b/perl.c index d8077d6..11a62e7 100644 --- a/perl.c +++ b/perl.c @@ -1289,10 +1289,19 @@ void perl_free(pTHXx) { #ifdef PERL_TRACK_MEMPOOL - /* Emulate the PerlHost behaviour of free()ing all memory allocated in this - thread at thread exit. */ - while(aTHXx->Imemory_debug_header.next != &(aTHXx->Imemory_debug_header)) - safesysfree(sTHX + (char *)(aTHXx->Imemory_debug_header.next)); + { + /* + * Don't free thread memory if PERL_DESTRUCT_LEVEL is set to a non-zero + * value as we're probably hunting memory leaks then + */ + const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL"); + if (!s || atoi(s) == 0) { + /* Emulate the PerlHost behaviour of free()ing all memory allocated in this + thread at thread exit. */ + while(aTHXx->Imemory_debug_header.next != &(aTHXx->Imemory_debug_header)) + safesysfree(sTHX + (char *)(aTHXx->Imemory_debug_header.next)); + } + } #endif #if defined(WIN32) || defined(NETWARE) -- 2.7.4