| 1 |
Fix a segmentation fault with 'debugperl -Dm'. Upstream change 33388.
|
| 2 |
|
| 3 |
diff --git a/perl.c b/perl.c
|
| 4 |
index e0bc0e7..c5a2070 100644
|
| 5 |
--- a/perl.c
|
| 6 |
+++ b/perl.c
|
| 7 |
@@ -1364,10 +1364,17 @@ perl_free(pTHXx)
|
| 8 |
*/
|
| 9 |
const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL");
|
| 10 |
if (!s || atoi(s) == 0) {
|
| 11 |
+ const U32 old_debug = PL_debug;
|
| 12 |
/* Emulate the PerlHost behaviour of free()ing all memory allocated in this
|
| 13 |
thread at thread exit. */
|
| 14 |
+ if (DEBUG_m_TEST) {
|
| 15 |
+ PerlIO_puts(Perl_debug_log, "Disabling memory debugging as we "
|
| 16 |
+ "free this thread's memory\n");
|
| 17 |
+ PL_debug &= ~ DEBUG_m_FLAG;
|
| 18 |
+ }
|
| 19 |
while(aTHXx->Imemory_debug_header.next != &(aTHXx->Imemory_debug_header))
|
| 20 |
safesysfree(sTHX + (char *)(aTHXx->Imemory_debug_header.next));
|
| 21 |
+ PL_debug = old_debug;
|
| 22 |
}
|
| 23 |
}
|
| 24 |
#endif
|
| 25 |
diff --git a/util.c b/util.c
|
| 26 |
index 62fd7ba..d8796cf 100644
|
| 27 |
--- a/util.c
|
| 28 |
+++ b/util.c
|
| 29 |
@@ -178,11 +178,11 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
|
| 30 |
ptr = (Malloc_t)PerlMem_realloc(where,size);
|
| 31 |
PERL_ALLOC_CHECK(ptr);
|
| 32 |
|
| 33 |
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) rfree\n",PTR2UV(where),(long)PL_an++));
|
| 34 |
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
|
| 35 |
-
|
| 36 |
- if (ptr != NULL) {
|
| 37 |
+ /* MUST do this fixup first, before doing ANYTHING else, as anything else
|
| 38 |
+ might allocate memory/free/move memory, and until we do the fixup, it
|
| 39 |
+ may well be chasing (and writing to) free memory. */
|
| 40 |
#ifdef PERL_TRACK_MEMPOOL
|
| 41 |
+ if (ptr != NULL) {
|
| 42 |
struct perl_memory_debug_header *const header
|
| 43 |
= (struct perl_memory_debug_header *)ptr;
|
| 44 |
|
| 45 |
@@ -198,7 +198,17 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
|
| 46 |
header->prev->next = header;
|
| 47 |
|
| 48 |
ptr = (Malloc_t)((char*)ptr+sTHX);
|
| 49 |
+ }
|
| 50 |
#endif
|
| 51 |
+
|
| 52 |
+ /* In particular, must do that fixup above before logging anything via
|
| 53 |
+ *printf(), as it can reallocate memory, which can cause SEGVs. */
|
| 54 |
+
|
| 55 |
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) rfree\n",PTR2UV(where),(long)PL_an++));
|
| 56 |
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
|
| 57 |
+
|
| 58 |
+
|
| 59 |
+ if (ptr != NULL) {
|
| 60 |
return ptr;
|
| 61 |
}
|
| 62 |
else if (PL_nomemok)
|
Parent Directory
| 
Revision Log