diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclCompile.c | 73 |
2 files changed, 49 insertions, 30 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 + 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 3bedf39..357a27a 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -482,9 +482,6 @@ TclSetByteCodeFromAny( Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ - register AuxData *auxDataPtr; - LiteralEntry *entryPtr; - register int i; int length, result = TCL_OK; const char *stringPtr; ContLineLoc* clLocPtr; @@ -553,35 +550,14 @@ TclSetByteCodeFromAny( 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); - fflush(stdout); - } -#endif /* TCL_COMPILE_DEBUG */ - - if (result != TCL_OK) { - /* - * Handle any error from the hookProc - */ - - 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++; + if (tclTraceCompile >= 2) { + TclPrintByteCodeObj(interp, objPtr); + fflush(stdout); } +#endif /* TCL_COMPILE_DEBUG */ } TclFreeCompileEnv(&compEnv); @@ -1050,6 +1026,32 @@ TclFreeCompileEnv( ckfree((char *) envPtr->localLitTable.buckets); envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets; } + if (envPtr->iPtr) { + /* + * 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); } @@ -1210,6 +1212,10 @@ TclCompileScript( Tcl_Parse *parsePtr = (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse)); + if (envPtr->iPtr == NULL) { + Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv"); + } + Tcl_DStringInit(&ds); if (numBytes < 0) { @@ -2116,6 +2122,10 @@ TclInitByteCodeObj( int i, isNew; Interp *iPtr; + if (envPtr->iPtr == NULL) { + Tcl_Panic("TclInitByteCodeObj() called on uninitialized CompileEnv"); + } + iPtr = envPtr->iPtr; codeBytes = (envPtr->codeNext - envPtr->codeStart); @@ -2233,6 +2243,9 @@ TclInitByteCodeObj( &isNew), envPtr->extCmdMapPtr); envPtr->extCmdMapPtr = NULL; + /* We've used up the CompileEnv. Mark as uninitialized. */ + envPtr->iPtr = NULL; + codePtr->localCachePtr = NULL; } |