summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2008-01-16 19:44:11 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2008-01-16 19:44:11 (GMT)
commit649a6115420f5c28c50feee55a7e0e441b22188d (patch)
tree87fb0a03684559d93d38d2a49416a4bbd053e9a0
parent90cf37f28b485d5cfdf799b2ead8bf7e1d57b479 (diff)
downloadtcl-649a6115420f5c28c50feee55a7e0e441b22188d.zip
tcl-649a6115420f5c28c50feee55a7e0e441b22188d.tar.gz
tcl-649a6115420f5c28c50feee55a7e0e441b22188d.tar.bz2
* generic/tclCompExpr.c: Fix literal leak in exprs [Bug 1869989]
* generic/tclExecute.c: (dgp)
-rw-r--r--ChangeLog3
-rw-r--r--generic/tclCompExpr.c61
-rw-r--r--generic/tclExecute.c9
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);
/*