summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2013-02-22 17:38:16 (GMT)
committerdgp <dgp@users.sourceforge.net>2013-02-22 17:38:16 (GMT)
commit5752e55c3fe28ff4844c8bdae2aca996c3abcb12 (patch)
treea516e61da72173e93c5bcf790ff4767a3cf18a1e
parent7c09879dbba02a4c3b86b6fbc4b9f1a05dba7b5b (diff)
parent6bd81a4dac7ec52c342aeb40e59ff6ea2387669a (diff)
downloadtcl-5752e55c3fe28ff4844c8bdae2aca996c3abcb12.zip
tcl-5752e55c3fe28ff4844c8bdae2aca996c3abcb12.tar.gz
tcl-5752e55c3fe28ff4844c8bdae2aca996c3abcb12.tar.bz2
Shift more burden of smart cleanup onto the TclFreeCompileEnv() routine.
Stop crashes when the hookProc raises an error.
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclCompile.c74
-rw-r--r--generic/tclExecute.c19
3 files changed, 50 insertions, 49 deletions
diff --git a/ChangeLog b/ChangeLog
index a2970f3..e049689 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2013-02-22 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompile.c: Shift more burden of smart cleanup onto the
+ * generic/tclExecute.c: TclFreeCompileEnv() routine. Stop crashes
+ when the hookProc raises an error.
+
2013-02-20 Don Porter <dgp@users.sourceforge.net>
* generic/tclNamesp.c: [Bug 3605447] Make sure the -clear option
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 1ec7c58..d27c9b6 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -361,9 +361,6 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
CompileEnv compEnv; /* Compilation environment structure
* allocated in frame. */
LiteralTable *localTablePtr = &(compEnv.localLitTable);
- register AuxData *auxDataPtr;
- LiteralEntry *entryPtr;
- register int i;
int length, nested, result;
char *string;
#ifdef TCL_TIP280
@@ -443,38 +440,16 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
TclVerifyLocalLiteralTable(&compEnv);
#endif /*TCL_COMPILE_DEBUG*/
- TclInitByteCodeObj(objPtr, &compEnv);
+ if (result == TCL_OK) {
+ TclInitByteCodeObj(objPtr, &compEnv);
#ifdef TCL_COMPILE_DEBUG
- if (tclTraceCompile >= 2) {
- TclPrintByteCodeObj(interp, objPtr);
- }
-#endif /* TCL_COMPILE_DEBUG */
- }
-
- if (result != TCL_OK) {
- /*
- * Compilation errors.
- */
-
- entryPtr = compEnv.literalArrayPtr;
- for (i = 0; i < compEnv.literalArrayNext; i++) {
- TclReleaseLiteral(interp, entryPtr->objPtr);
- entryPtr++;
- }
-#ifdef TCL_COMPILE_DEBUG
- TclVerifyGlobalLiteralTable(iPtr);
-#endif /*TCL_COMPILE_DEBUG*/
-
- auxDataPtr = compEnv.auxDataArrayPtr;
- for (i = 0; i < compEnv.auxDataArrayNext; i++) {
- if (auxDataPtr->type->freeProc != NULL) {
- auxDataPtr->type->freeProc(auxDataPtr->clientData);
+ if (tclTraceCompile >= 2) {
+ TclPrintByteCodeObj(interp, objPtr);
}
- auxDataPtr++;
+#endif /* TCL_COMPILE_DEBUG */
}
}
-
-
+
/*
* Free storage allocated during compilation.
*/
@@ -947,6 +922,32 @@ void
TclFreeCompileEnv(envPtr)
register CompileEnv *envPtr; /* Points to the CompileEnv structure. */
{
+ if (envPtr->source) {
+ /*
+ * We never converted to Bytecode, so free the things we would
+ * have transferred to it.
+ */
+
+ int i;
+ LiteralEntry *entryPtr = envPtr->literalArrayPtr;
+ AuxData *auxDataPtr = envPtr->auxDataArrayPtr;
+
+ for (i = 0; i < envPtr->literalArrayNext; i++) {
+ TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, entryPtr->objPtr);
+ entryPtr++;
+ }
+
+#ifdef TCL_COMPILE_DEBUG
+ TclVerifyGlobalLiteralTable(envPtr->iPtr);
+#endif /*TCL_COMPILE_DEBUG*/
+
+ for (i = 0; i < envPtr->auxDataArrayNext; i++) {
+ if (auxDataPtr->type->freeProc != NULL) {
+ auxDataPtr->type->freeProc(auxDataPtr->clientData);
+ }
+ auxDataPtr++;
+ }
+ }
if (envPtr->mallocedCodeArray) {
ckfree((char *) envPtr->codeStart);
}
@@ -1088,6 +1089,10 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
int* clNext;
#endif
+ if (envPtr->source == NULL) {
+ Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
+ }
+
Tcl_DStringInit(&ds);
if (numBytes < 0) {
@@ -1991,6 +1996,10 @@ TclInitByteCodeObj(objPtr, envPtr)
#endif
Interp *iPtr;
+ if (envPtr->source == NULL) {
+ Tcl_Panic("TclInitByteCodeObj() called on uninitialized CompileEnv");
+ }
+
iPtr = envPtr->iPtr;
codeBytes = (envPtr->codeNext - envPtr->codeStart);
@@ -2110,6 +2119,9 @@ TclInitByteCodeObj(objPtr, envPtr)
envPtr->extCmdMapPtr);
envPtr->extCmdMapPtr = NULL;
#endif
+
+ /* We've used up the CompileEnv. Mark as uninitialized. */
+ envPtr->source = NULL;
}
/*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index c09b73e..1ae182c 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -724,11 +724,9 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
register ByteCode *codePtr = NULL;
/* Tcl Internal type of bytecode.
* Initialized to avoid compiler warning. */
- AuxData *auxDataPtr;
- LiteralEntry *entryPtr;
Tcl_Obj *saveObjPtr;
char *string;
- int length, i, result;
+ int length, result;
/*
* First handle some common expressions specially.
@@ -808,22 +806,7 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
#ifdef TCL_COMPILE_DEBUG
TclVerifyLocalLiteralTable(&compEnv);
#endif /*TCL_COMPILE_DEBUG*/
- entryPtr = compEnv.literalArrayPtr;
- for (i = 0; i < compEnv.literalArrayNext; i++) {
- TclReleaseLiteral(interp, entryPtr->objPtr);
- entryPtr++;
- }
-#ifdef TCL_COMPILE_DEBUG
- TclVerifyGlobalLiteralTable(iPtr);
-#endif /*TCL_COMPILE_DEBUG*/
- auxDataPtr = compEnv.auxDataArrayPtr;
- for (i = 0; i < compEnv.auxDataArrayNext; i++) {
- if (auxDataPtr->type->freeProc != NULL) {
- auxDataPtr->type->freeProc(auxDataPtr->clientData);
- }
- auxDataPtr++;
- }
TclFreeCompileEnv(&compEnv);
goto done;
}