diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclCompile.c | 74 | ||||
| -rw-r--r-- | generic/tclExecute.c | 19 |
3 files changed, 50 insertions, 49 deletions
@@ -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; } |