summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorandreask <andreask>2015-05-27 18:25:38 (GMT)
committerandreask <andreask>2015-05-27 18:25:38 (GMT)
commitd5216492533d69d423a9b113cb23a024ea2d500f (patch)
tree36b76533e102724d72049664813d8ea4459b781f /generic
parent621d3d100215359bf2411b11c66d197eb6530a61 (diff)
parentfa3ea271d38aa3ba728701d6a921a06a8f313786 (diff)
downloadtcl-d5216492533d69d423a9b113cb23a024ea2d500f.zip
tcl-d5216492533d69d423a9b113cb23a024ea2d500f.tar.gz
tcl-d5216492533d69d423a9b113cb23a024ea2d500f.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 fb09a9e..d278b1f 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -1322,6 +1322,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((char *) 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
@@ -3717,20 +3750,6 @@ Tcl_DbDecrRefCount(
"Trying to decr ref count of "
"Tcl_Obj allocated in another thread");
}
-
- /*
- * 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((char *) objData);
- }
-
- Tcl_DeleteHashEntry(hPtr);
- }
}
# endif
#endif