Check that the thread incrementing or decrementing

	the ref count of a Tcl_Obj is the thread that
	originally allocated the thread. This fail fast
	behavior will catch programming errors that
	allow a single Tcl_Obj to be accessed from multiple
	threads.

	* generic/tcl.h (Tcl_Obj): Add allocThread member
	to Tcl_Obj. This member records the thread id the
	Tcl_Obj was allocated. It is used to check that
	any future ref count incr or decr is done from
	the same thread that allocated the Tcl_Obj.
	This member is defined only when threads and
	mem debug are enabled.
	* generic/tclInt.h (TclNewObj, TclDbNewObj,
	TclDecrRefCount):
	Define TclNewObj and TclDbNewObj using TclDbInitNewObj
	when mem debug is enabled. This fixes a problem where
	TclNewObj calls did not work the same as TclDbNewObj
	when mem debug was enabled.
	* generic/tclObj.c (TclDbInitNewObj, Tcl_DbIncrRefCount,
	Tcl_DbDecrRefCount): Add new helper to init Tcl_Obj
	members when mem debug is enabled. Init the allocThread
	member in TclDbInitNewObj and check it in
	Tcl_DbIncrRefCount and Tcl_DbDecrRefCount to make sure
	a Tcl_Obj allocated in one thread is not being acted
	upon in another thread.

1 files changed, 47 insertions, 1 deletions

diff --git a/generic/tclObj.c b/generic/tclObj.c
index 97db9f4..3ab7ee9 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclObj.c,v 1.47 2003/05/23 21:29:51 dgp Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.48 2003/07/22 00:59:58 mdejong Exp $
  */
 
 #include "tclInt.h"
@@ -484,6 +484,37 @@ Tcl_ConvertToType(interp, objPtr, typePtr)
 /*
  *----------------------------------------------------------------------
  *
+ * TclDbInitNewObj --
+ *
+ *	Called via the TclNewObj or TclDbNewObj macros when TCL_MEM_DEBUG
+ *	is enabled. This function will initialize the members of a
+ *	Tcl_Obj struct. Initilization would be done inline via the
+ *	TclNewObj macro when compiling without TCL_MEM_DEBUG.
+ *
+ * Results:
+ *	The Tcl_Obj struct members are initialized.
+ *
+ * Side effects:
+ *	None.
+ *----------------------------------------------------------------------
+ */
+#ifdef TCL_MEM_DEBUG
+void TclDbInitNewObj(objPtr)
+    register Tcl_Obj *objPtr;
+{
+    objPtr->refCount = 0;
+    objPtr->bytes = tclEmptyStringRep;
+    objPtr->length = 0;
+    objPtr->typePtr = NULL;
+# ifdef TCL_THREADS
+    objPtr->allocThread = Tcl_GetCurrentThread();
+# endif /* TCL_THREADS */
+}
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_NewObj --
  *
  *	This procedure is normally called when not debugging: i.e., when
@@ -2526,6 +2557,11 @@ Tcl_DbIncrRefCount(objPtr, file, line)
 	fflush(stderr);
 	panic("Trying to increment refCount of previously disposed object.");
     }
+#ifdef TCL_THREADS
+    if (Tcl_GetCurrentThread() != objPtr->allocThread) {
+        panic("Attempt to incr Tcl_Obj ref count in another thread");
+    }
+#endif
 #endif
     ++(objPtr)->refCount;
 }
@@ -2566,6 +2602,11 @@ Tcl_DbDecrRefCount(objPtr, file, line)
 	fflush(stderr);
 	panic("Trying to decrement refCount of previously disposed object.");
     }
+#ifdef TCL_THREADS
+    if (Tcl_GetCurrentThread() != objPtr->allocThread) {
+        panic("Attempt to decr Tcl_Obj ref count in another thread");
+    }
+#endif
 #endif
     if (--(objPtr)->refCount <= 0) {
 	TclFreeObj(objPtr);
@@ -2607,6 +2648,11 @@ Tcl_DbIsShared(objPtr, file, line)
 	fflush(stderr);
 	panic("Trying to check whether previously disposed object is shared.");
     }
+#ifdef TCL_THREADS
+    if (Tcl_GetCurrentThread() != objPtr->allocThread) {
+        panic("Attempt to query shared status in another thread");
+    }
+#endif
 #endif
 #ifdef TCL_COMPILE_STATS
     Tcl_MutexLock(&tclObjMutex);