From 649a6115420f5c28c50feee55a7e0e441b22188d Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Wed, 16 Jan 2008 19:44:11 +0000
Subject: 	* generic/tclCompExpr.c: Fix literal leak in exprs [Bug
 1869989] 	* generic/tclExecute.c:  (dgp)

---
 ChangeLog             |  3 +++
 generic/tclCompExpr.c | 61 ++++++++++++++++++---------------------------------
 generic/tclExecute.c  |  9 +++++++-
 3 files changed, 32 insertions(+), 41 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 00ccc1e..62bd72b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 2008-01-15  Miguel Sofer  <msofer@users.sf.net>
 
+	* generic/tclCompExpr.c: Fix literal leak in exprs [Bug 1869989] 
+	* generic/tclExecute.c:  (dgp)
+	
 	* doc/proc.n: changed wording for access to non-local variables;
 	added mention to [namespace upvar]. Lame attempt at dealing with
 	documentation [Bug 1872708]
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 19f30bd..22022cf 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompExpr.c,v 1.91 2008/01/15 11:59:27 msofer Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.92 2008/01/16 19:44:13 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -833,47 +833,13 @@ ParseExpr(
 
 	    switch (lexeme) {
 	    case NUMBER:
-	    case BOOLEAN: {
-		if (interp) {
-		    int new;
-		    /* LiteralEntry *lePtr; */
-		    Tcl_Obj *objPtr = TclCreateLiteral((Interp *)interp,
-			    (char *)start, scanned,
-			    /* hash */ (unsigned int) -1, &new,
-			    /* nsPtr */ NULL, /* flags */ 0,
-			    NULL /* &lePtr */);
-		    if (objPtr->typePtr != literal->typePtr) {
-			/*
-			 * What we would like to do is this:
-			 *
-			 * lePtr->objPtr = literal;
-			 * Tcl_IncrRefCount(literal);
-			 * Tcl_DecrRefCount(objPtr);
-			 *
-			 * However, the design of the "global" and "local"
-			 * LiteralTable does not permit the value of
-			 * lePtr->objPtr to be changed.  So rather than
-			 * replace lePtr->objPtr, we do surgery to transfer
-			 * the intrep of literal into it.  Ugly stuff here
-			 * that's generally unsafe, but ok here since we know
-			 * the Tcl_ObjTypes literal might possibly have.
-			 */
-			Tcl_Obj *toFree = literal;
-			literal = objPtr;
-			TclFreeIntRep(literal);
-			literal->typePtr = toFree->typePtr;
-			literal->internalRep = toFree->internalRep;
-			toFree->typePtr = NULL;
-			Tcl_DecrRefCount(toFree);
-		    }
-		}
-
+	    case BOOLEAN: 
 		Tcl_ListObjAppendElement(NULL, litList, literal);
 		complete = lastParsed = OT_LITERAL;
 		start += scanned;
 		numBytes -= scanned;
 		continue;
-	    }
+	    
 	    default:
 		break;
 	    }
@@ -2345,10 +2311,25 @@ CompileExprTree(
 	case OT_LITERAL: {
 	    Tcl_Obj *const *litObjv = *litObjvPtr;
 	    Tcl_Obj *literal = *litObjv;
-	    int length;
-	    const char *bytes = TclGetStringFromObj(literal, &length);
 
-	    TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, length), envPtr);
+	    if (optimize) {
+		int length;
+		const char *bytes = TclGetStringFromObj(literal, &length);
+
+		/* TODO: Consider ways to preserve intrep */
+		TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, length),
+			envPtr);
+	    } else {
+		/*
+		 * When optimize==0, we know the expression is a one-off
+		 * and there's nothing to be gained from sharing literals
+		 * when they won't live long, and the copies we have already
+		 * have an appropriate intrep.  In this case, skip literal
+		 * registration that would enable sharing, and use the routine
+		 * that preserves intreps.
+		 */
+		TclEmitPush(TclAddLiteralObj(envPtr, literal, NULL), envPtr);
+	    }
 	    (*litObjvPtr)++;
 	    break;
 	}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 8793312..472ed7f 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.358 2007/12/17 15:28:27 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.359 2008/01/16 19:44:13 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1228,6 +1228,13 @@ Tcl_ExprObj(
 	const char *string = TclGetStringFromObj(objPtr, &length);
 
 	TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0);
+	
+	/*
+	 * TODO: Consider creating and calling an alternative routine
+	 * that will compile bytecode for one-off expressions like this
+	 * one with optimize==0, for improved efficiency.
+	 */
+
 	TclCompileExpr(interp, string, length, &compEnv);
 
 	/*
-- 
cgit v0.12