From 812f825cfcb54b05a3df59e2cb1585af3da47c67 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 10 Mar 2016 20:03:38 +0000 Subject: [b9b2079e6d] Proposed fix. When a compileProc fails, it may have done an arbitrary amount of partial work, which needs to be undone. When the exception handling machinery got its last big revision, the undoing of what it does was neglected. I think this patch gets it all, but more eyes would be good. --- generic/tclEnsemble.c | 43 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 8f7d1a2..986a553 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -3082,6 +3082,11 @@ TclAttemptCompileProc( Tcl_Token *saveTokenPtr = parsePtr->tokenPtr; int savedStackDepth = envPtr->currStackDepth; unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart; + int savedAuxDataArrayNext = envPtr->auxDataArrayNext; + int savedExceptArrayNext = envPtr->exceptArrayNext; +#ifdef TCL_COMPILE_DEBUG + int savedExceptDepth = envPtr->exceptDepth; +#endif DefineLineInformation; if (cmdPtr->compileProc == NULL) { @@ -3130,7 +3135,45 @@ TclAttemptCompileProc( * we avoid compiling subcommands that recursively call TclCompileScript(). */ +#ifdef TCL_COMPILE_DEBUG + if (envPtr->exceptDepth != savedExceptDepth) { + Tcl_Panic("ExceptionRange Starts and Ends do not balance"); + } +#endif + if (result != TCL_OK) { + ExceptionAux *auxPtr = envPtr->exceptAuxArrayPtr; + + for (i = 0; i < savedExceptArrayNext; i++) { + while (auxPtr->numBreakTargets > 0 + && auxPtr->breakTargets[auxPtr->numBreakTargets - 1] + >= savedCodeNext) { + auxPtr->numBreakTargets--; + } + while (auxPtr->numContinueTargets > 0 + && auxPtr->continueTargets[auxPtr->numContinueTargets - 1] + >= savedCodeNext) { + auxPtr->numContinueTargets--; + } + auxPtr++; + } + envPtr->exceptArrayNext = savedExceptArrayNext; + + if (savedAuxDataArrayNext != envPtr->auxDataArrayNext) { + AuxData *auxDataPtr = envPtr->auxDataArrayPtr; + AuxData *auxDataEnd = auxDataPtr; + + auxDataPtr += savedAuxDataArrayNext; + auxDataEnd += envPtr->auxDataArrayNext; + + while (auxDataPtr < auxDataEnd) { + if (auxDataPtr->type->freeProc != NULL) { + auxDataPtr->type->freeProc(auxDataPtr->clientData); + } + auxDataPtr++; + } + envPtr->auxDataArrayNext = savedAuxDataArrayNext; + } envPtr->currStackDepth = savedStackDepth; envPtr->codeNext = envPtr->codeStart + savedCodeNext; #ifdef TCL_COMPILE_DEBUG -- cgit v0.12