diff options
| -rw-r--r-- | perl.c | 7 | ||||
| -rw-r--r-- | util.c | 18 |
2 files changed, 21 insertions, 4 deletions
@@ -1376,10 +1376,17 @@ perl_free(pTHXx) */ const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL"); if (!s || atoi(s) == 0) { + const U32 old_debug = PL_debug; /* Emulate the PerlHost behaviour of free()ing all memory allocated in this thread at thread exit. */ + if (DEBUG_m_TEST) { + PerlIO_puts(Perl_debug_log, "Disabling memory debugging as we " + "free this thread's memory\n"); + PL_debug &= ~ DEBUG_m_FLAG; + } while(aTHXx->Imemory_debug_header.next != &(aTHXx->Imemory_debug_header)) safesysfree(sTHX + (char *)(aTHXx->Imemory_debug_header.next)); + PL_debug = old_debug; } } #endif @@ -178,11 +178,11 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) ptr = (Malloc_t)PerlMem_realloc(where,size); PERL_ALLOC_CHECK(ptr); - DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) rfree\n",PTR2UV(where),(long)PL_an++)); - DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size)); - - if (ptr != NULL) { + /* MUST do this fixup first, before doing ANYTHING else, as anything else + might allocate memory/free/move memory, and until we do the fixup, it + may well be chasing (and writing to) free memory. */ #ifdef PERL_TRACK_MEMPOOL + if (ptr != NULL) { struct perl_memory_debug_header *const header = (struct perl_memory_debug_header *)ptr; @@ -198,7 +198,17 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) header->prev->next = header; ptr = (Malloc_t)((char*)ptr+sTHX); + } #endif + + /* In particular, must do that fixup above before logging anything via + *printf(), as it can reallocate memory, which can cause SEGVs. */ + + DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) rfree\n",PTR2UV(where),(long)PL_an++)); + DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size)); + + + if (ptr != NULL) { return ptr; } else if (PL_nomemok) |