summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorandreask <andreask>2015-05-27 18:35:46 (GMT)
committerandreask <andreask>2015-05-27 18:35:46 (GMT)
commit32461a99d3dc5741caf2f1c282ca57fe06220b79 (patch)
tree9f006eef5c2f1880b9a39401a6f18d18bf63c0d3 /generic
parent96ce6fe4871c2c4cd46105d106d5fbcd3d0f6c86 (diff)
parentd5216492533d69d423a9b113cb23a024ea2d500f (diff)
downloadtcl-32461a99d3dc5741caf2f1c282ca57fe06220b79.zip
tcl-32461a99d3dc5741caf2f1c282ca57fe06220b79.tar.gz
tcl-32461a99d3dc5741caf2f1c282ca57fe06220b79.tar.bz2
Make tweak to the mem-debug tracking official. It is now again possible to use regular packages with a mem-debug core without inciting a panic.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclObj.c47
1 files changed, 33 insertions, 14 deletions
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 930e1fd..9caca72 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -1301,6 +1301,39 @@ TclFreeObj(
ObjInitDeletionContext(context);
+# ifdef TCL_THREADS
+ /*
+ * Check to make sure that the Tcl_Obj was allocated by the current
+ * thread. Don't do this check when shutting down since thread local
+ * storage can be finalized before the last Tcl_Obj is freed.
+ */
+
+ if (!TclInExit()) {
+ Tcl_HashTable *tablePtr;
+ Tcl_HashEntry *hPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ tablePtr = tsdPtr->objThreadMap;
+ if (!tablePtr) {
+ Tcl_Panic("TclFreeObj: object table not initialized");
+ }
+ hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
+ if (hPtr) {
+ /*
+ * As the Tcl_Obj is going to be deleted we remove the entry.
+ */
+
+ ObjData *objData = Tcl_GetHashValue(hPtr);
+
+ if (objData != NULL) {
+ ckfree(objData);
+ }
+
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ }
+# endif
+
/*
* Check for a double free of the same value. This is slightly tricky
* because it is customary to free a Tcl_Obj when its refcount falls
@@ -3766,20 +3799,6 @@ Tcl_DbDecrRefCount(
Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
"decr ref count");
}
-
- /*
- * If the Tcl_Obj is going to be deleted, remove the entry.
- */
-
- if ((objPtr->refCount - 1) <= 0) {
- ObjData *objData = Tcl_GetHashValue(hPtr);
-
- if (objData != NULL) {
- ckfree(objData);
- }
-
- Tcl_DeleteHashEntry(hPtr);
- }
}
# endif /* TCL_THREADS */
#endif /* TCL_MEM_DEBUG */