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.

3 files changed, 75 insertions, 24 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index 48a6c15..bbe13a7 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tcl.h,v 1.160 2003/07/18 02:02:02 das Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.161 2003/07/22 00:59:58 mdejong Exp $
  */
 
 #ifndef _TCL
@@ -778,6 +778,15 @@ typedef struct Tcl_Obj {
 	    VOID *ptr2;
 	} twoPtrValue;
     } internalRep;
+
+    /*
+     * Thread id used to check that calls to Tcl_IncrRefCount,
+     * Tcl_DecrRefCount, and Tcl_IsShared are being made
+     * from the thread that originally allocated the Tcl_Obj.
+     */
+#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+    Tcl_ThreadId allocThread;
+#endif
 } Tcl_Obj;
 
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 02987c2..040e359 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.128 2003/06/09 22:48:32 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.129 2003/07/22 00:59:58 mdejong Exp $
  */
 
 #ifndef _TCLINT
@@ -2087,15 +2087,16 @@ EXTERN Tcl_Obj *TclPtrIncrWideVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr,
 #  define TclIncrObjsFreed()
 #endif /* TCL_COMPILE_STATS */
 
-#define TclNewObj(objPtr) \
-    TclAllocObjStorage(objPtr); \
+#ifndef TCL_MEM_DEBUG
+# define TclNewObj(objPtr) \
     TclIncrObjsAllocated(); \
+    TclAllocObjStorage(objPtr); \
     (objPtr)->refCount = 0; \
     (objPtr)->bytes    = tclEmptyStringRep; \
     (objPtr)->length   = 0; \
     (objPtr)->typePtr  = NULL
 
-#define TclDecrRefCount(objPtr) \
+# define TclDecrRefCount(objPtr) \
     if (--(objPtr)->refCount <= 0) { \
 	if (((objPtr)->typePtr != NULL) \
 		&& ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
@@ -2108,27 +2109,22 @@ EXTERN Tcl_Obj *TclPtrIncrWideVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr,
         TclFreeObjStorage(objPtr); \
 	TclIncrObjsFreed(); \
     }
+#endif /* TCL_MEM_DEBUG */
 
 #ifdef TCL_MEM_DEBUG
-#  define TclAllocObjStorage(objPtr) \
-       (objPtr) = (Tcl_Obj *) \
-           Tcl_DbCkalloc(sizeof(Tcl_Obj), __FILE__, __LINE__)
+EXTERN void	TclDbInitNewObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+# define TclDbNewObj(objPtr, file, line) \
+    TclIncrObjsAllocated(); \
+    (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
+    TclDbInitNewObj(objPtr);
+
+# define TclNewObj(objPtr) \
+    TclDbNewObj(objPtr, __FILE__, __LINE__);
+
+# define TclDecrRefCount(objPtr) \
+    Tcl_DecrRefCount(objPtr);
 
-#  define TclFreeObjStorage(objPtr) \
-       if ((objPtr)->refCount < -1) { \
-           panic("Reference count for %lx was negative: %s line %d", \
-	           (objPtr), __FILE__, __LINE__); \
-       } \
-       ckfree((char *) (objPtr))
-     
-#  define TclDbNewObj(objPtr, file, line) \
-       (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
-       (objPtr)->refCount = 0; \
-       (objPtr)->bytes    = tclEmptyStringRep; \
-       (objPtr)->length   = 0; \
-       (objPtr)->typePtr  = NULL; \
-       TclIncrObjsAllocated()
-     
 #elif defined(PURIFY)
 
 /*
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);