Shift more burden of smart cleanup onto the TclFreeCompileEnv() routine.

Stop crashes when the hookProc raises an error.

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;
 	}