From 6bd81a4dac7ec52c342aeb40e59ff6ea2387669a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 21 Feb 2013 21:14:55 +0000
Subject: Protect against multiple uses of a CompileEnv with only one
 initialization. Make TclFreeCompileEnv smarter about cleanup so all callers
 do not have to be. Revise TclSetByteCodeFromAny() so that when hookProc
 raises an error, bytecode is not generated.  This was rumored to cause
 crashes.

---
 generic/tclCompile.c | 74 ++++++++++++++++++++++++++++++----------------------
 generic/tclExecute.c | 19 +-------------
 2 files changed, 44 insertions(+), 49 deletions(-)

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;
 	}
-- 
cgit v0.12