From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 23 Dec 2005 17:30:19 +0000 (+0000)
Subject: For PERL_TRACK_MEMPOOL with PERL_POISON, Poison the end of any block
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2bee601c49fc5d1680112c819094102e0fe163b2;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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