From 8ce56aea8a1c79732d3923703030a53807b1fa40 Mon Sep 17 00:00:00 2001
From: stanton <stanton>
Date: Tue, 8 Dec 1998 04:29:48 +0000
Subject: * generic/tclAlloc.c (TclpRealloc): Fixed a memory allocation bug
 where big blocks that were reallocated into a different heap location were
 not being placed into the bigBlocks list. [Bug: 933]

---
 ChangeLog          |  4 ++++
 generic/tclAlloc.c | 16 +++++++++++++++-
 tests/regexp.test  | 18 +++++++++++++++++-
 3 files changed, 36 insertions(+), 2 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 32486b4..e4d2113 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
 1998-12-07    <stanton@GASPODE>
 
+	* generic/tclAlloc.c (TclpRealloc): Fixed a memory allocation bug
+	where big blocks that were reallocated into a different heap
+	location were not being placed into the bigBlocks list. [Bug: 933]
+
 	* tests/msgcat.test: Added message catalog test suite.
 
 	* library/msgcat1.0/msgcat.tcl: minor bug fixes, integrated latest
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index d309319..20675e2 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclAlloc.c,v 1.1.2.3 1998/11/18 03:34:27 stanton Exp $
+ * RCS: @(#) $Id: tclAlloc.c,v 1.1.2.4 1998/12/08 04:29:49 stanton Exp $
  */
 
 #include "tclInt.h"
@@ -520,13 +520,27 @@ TclpRealloc(
      */
 
     if (i == 0xff) {
+	struct block *prevPtr, *nextPtr;
 	bigBlockPtr = (struct block *) op - 1;
+	prevPtr = bigBlockPtr->prevPtr;
+	nextPtr = bigBlockPtr->nextPtr;
 	bigBlockPtr = (struct block *) TclpSysRealloc(bigBlockPtr, 
 		sizeof(struct block) + OVERHEAD + nbytes);
 	if (bigBlockPtr == NULL) {
 	    TclpMutexUnlock(&allocMutex);
 	    return NULL;
 	}
+
+	if (prevPtr->nextPtr != bigBlockPtr) {
+	    /*
+	     * If the block has moved, splice the new block into the list where
+	     * the old block used to be. 
+	     */
+
+	    prevPtr->nextPtr = bigBlockPtr;
+	    nextPtr->prevPtr = bigBlockPtr;
+	}
+
 	op = (union overhead *) (bigBlockPtr + 1);
 #ifdef MSTATS
 	nmalloc[NBUCKETS]++;
diff --git a/tests/regexp.test b/tests/regexp.test
index 29b94f6..b35efe7 100644
--- a/tests/regexp.test
+++ b/tests/regexp.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: regexp.test,v 1.1.2.5 1998/12/03 23:59:13 stanton Exp $
+# RCS: @(#) $Id: regexp.test,v 1.1.2.6 1998/12/08 04:29:49 stanton Exp $
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -342,4 +342,20 @@ test regexp-11.1 {Tcl_RegExpExec: large number of subexpressions} {
     list [regexp (.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) abcdefghijklmnopqrstuvwxyz all a b c d e f g h i j k l m n o p q r s t u v w x y z] $all $a $b $c $d $e $f $g $h $i $j $k $l $m $n $o $p $q $r $s $t $u $v $w $x $y $z
 } {1 abcdefghijklmnopqrstuvwxyz a b c d e f g h i j k l m n o p q r s t u v w x y z}
 
+test regexp-12.1 {regsub of a very large string} {
+    # This test is designed to stress the memory subsystem in order
+    # to catch Bug #933.  It only fails if the Tcl memory allocator
+    # is in use.
+
+    set line {BEGIN_TABLE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; END_TABLE}
+    set filedata ""
+    for {set i 1} {$i<200} {incr i} {
+	append filedata $line
+    }
+    for {set i 1} {$i<10} {incr i} {
+	regsub -all "BEGIN_TABLE " $filedata "" newfiledata
+    }
+    set x done
+} {done}
+
 return
-- 
cgit v0.12