summaryrefslogtreecommitdiffstats
path: root/generic/tclBasic.c
diff options
context:
space:
mode:
authorferrieux <ferrieux@users.sourceforge.net>2011-08-09 17:19:33 (GMT)
committerferrieux <ferrieux@users.sourceforge.net>2011-08-09 17:19:33 (GMT)
commite83ec9b8978e9e4481a549283c64e11f2a1e4a61 (patch)
tree82fd16a3ebffc1553c7b6bb3847e036f9fd6cc61 /generic/tclBasic.c
parent653f52ba6008466571d283d523272ae22c2cf2c4 (diff)
downloadtcl-e83ec9b8978e9e4481a549283c64e11f2a1e4a61.zip
tcl-e83ec9b8978e9e4481a549283c64e11f2a1e4a61.tar.gz
tcl-e83ec9b8978e9e4481a549283c64e11f2a1e4a61.tar.bz2
[Bug 2919042] Restore "valgrindability" of Tcl that was lost by the streamlining of [exit], by conditionally forcing a full Finalize: use -DPURIFY or ::env(TCL_FINALIZE_ON_EXIT)
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r--generic/tclBasic.c13
1 files changed, 7 insertions, 6 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a44d736..124f932 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -1355,10 +1355,11 @@ DeleteInterpProc(
int i;
/*
- * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup.
+ * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup,
+ * unless we are exiting.
*/
- if (iPtr->numLevels > 0) {
+ if ((iPtr->numLevels > 0) && !TclInExit()) {
Tcl_Panic("DeleteInterpProc called with active evals");
}
@@ -1481,7 +1482,7 @@ DeleteInterpProc(
* namespace. The order is important [Bug 1658572].
*/
- if (iPtr->framePtr != iPtr->rootFramePtr) {
+ if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) {
Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
}
Tcl_PopCallFrame(interp);
@@ -1602,7 +1603,7 @@ DeleteInterpProc(
* know which arguments will be used as scripts and which will not.
*/
- if (iPtr->lineLAPtr->numEntries) {
+ if (iPtr->lineLAPtr->numEntries && !TclInExit()) {
/*
* When the interp goes away we have nothing on the stack, so there
* are no arguments, so this table has to be empty.
@@ -1612,10 +1613,10 @@ DeleteInterpProc(
}
Tcl_DeleteHashTable(iPtr->lineLAPtr);
- ckfree(iPtr->lineLAPtr);
+ ckfree((char *) iPtr->lineLAPtr);
iPtr->lineLAPtr = NULL;
- if (iPtr->lineLABCPtr->numEntries) {
+ if (iPtr->lineLABCPtr->numEntries && !TclInExit()) {
/*
* When the interp goes away we have nothing on the stack, so there
* are no arguments, so this table has to be empty.