Do the memory debug header fixup earlier to avoid valgrind screaming

under -Dm. Also, temporarily disable memory logging during thread
memory freeing, as otherwise we try to log using memory we already
freed.

p4raw-id: //depot/perl@33388

diff --git a/perl.c b/perl.c
index 5680f29..a7f6ab5 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -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

diff --git a/util.c b/util.c
index 37e913e..36166fb 100644 (file)
--- a/util.c
+++ b/util.c
@@ -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)