For PERL_TRACK_MEMPOOL with PERL_POISON, Poison the end of any block

being shrunk in realloc()

p4raw-id: //depot/perl@26478

diff --git a/util.c b/util.c
index c9e4446..5263dd4 100644 (file)
--- a/util.c
+++ b/util.c
@@ -143,8 +143,13 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
         Perl_croak_nocontext("panic: realloc from wrong pool");
     }
 #  ifdef PERL_POISON
+    if (((struct perl_memory_debug_header *)where)->size > size) {
+       const MEM_SIZE freed_up =
+           ((struct perl_memory_debug_header *)where)->size - size;
+       char *start_of_freed = ((char *)where) + size;
+       Poison(start_of_freed, freed_up, char);
+    }
     ((struct perl_memory_debug_header *)where)->size = size;
-    /* FIXME poison the end if it gets shorter.  */
 #  endif
 #endif
 #ifdef DEBUGGING