Bug#474613: perl: -Dm crashes

[Niko Tyni]

tag 474613 patch fixed-upstream
thanks

On Sun, Apr 06, 2008 at 09:12:42PM +0300, Niko Tyni wrote:
> Package: perl
> Version: 5.10.0-7
> Severity: normal
> 
> Invoking 'debugperl -Dm -e 1' segfaults on both amd64 and i386 after
> lots of output, probably once it's all done.

This is fixed upstream (in blead but apparently not in maint-5.10 yet?) by

Change 33388 by [EMAIL PROTECTED] on 2008/02/27 16:45:20

    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.

Patch for 5.10.0 attached.

Cheers,
-- 
Niko Tyni   [EMAIL PROTECTED]

diff --git a/perl.c b/perl.c
index e0bc0e7..c5a2070 100644
--- a/perl.c
+++ b/perl.c
@@ -1364,10 +1364,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 62fd7ba..d8796cf 100644
--- 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)