Posted to tcl by andreas_kupries at Mon Apr 30 21:36:01 GMT 2007view raw
- Index: ChangeLog
- ===================================================================
- RCS file: /cvsroot/tcl/tcl/ChangeLog,v
- retrieving revision 1.3478
- diff -w -u -r1.3478 ChangeLog
- --- ChangeLog 30 Apr 2007 19:46:01 -0000 1.3478
- +++ ChangeLog 30 Apr 2007 21:34:53 -0000
- @@ -1,3 +1,10 @@
- +2007-04-30 Andreas Kupries <andreask@gactivestate.com>
- +
- + * generic/tclIO.c (FixLevelCode): Corrected reference count
- + mismanagement of newlevel, newcode. Changed to allocate the
- + Tcl_Obj's as late as possible, and only when actually needed. [Bug
- + 1705778, leak K29].
- +
- 2007-04-30 Kevin B, Kenny <kennykb@acm.org>
- * generic/tclProc.c (Tcl_ProcObjCmd, SetLambdaFromAny): Corrected
- Index: generic/tclIO.c
- ===================================================================
- RCS file: /cvsroot/tcl/tcl/generic/tclIO.c,v
- retrieving revision 1.118
- diff -w -u -r1.118 tclIO.c
- --- generic/tclIO.c 20 Apr 2007 05:51:10 -0000 1.118
- +++ generic/tclIO.c 30 Apr 2007 21:34:53 -0000
- @@ -9962,7 +9962,7 @@
- int explicitResult, numOptions, lc, lcn;
- Tcl_Obj **lv, **lvn;
- int res, i, j, val, lignore, cignore;
- - Tcl_Obj *newlevel = NULL, *newcode = NULL;
- + int newlevel = -1, newcode = -1;
- /* ASSERT msg != NULL */
- @@ -10005,7 +10005,7 @@
- res = Tcl_GetIntFromObj(NULL, lv[i+1], &val);
- if (((res == TCL_OK) && (val != 1)) || ((res != TCL_OK) &&
- (0 != strcmp(TclGetString(lv[i+1]), "error")))) {
- - newcode = Tcl_NewIntObj(1);
- + newcode = 1;
- }
- } else if (0 == strcmp(TclGetString(lv[i]), "-level")) {
- /*
- @@ -10014,7 +10014,7 @@
- res = Tcl_GetIntFromObj(NULL, lv [i+1], &val);
- if ((res != TCL_OK) || (val != 0)) {
- - newlevel = Tcl_NewIntObj(0);
- + newlevel = 0;
- }
- }
- }
- @@ -10023,7 +10023,7 @@
- * -code, -level are either not present or ok. Nothing to do.
- */
- - if (!newlevel && !newcode) {
- + if ((newlevel < 0) && (newcode < 0)) {
- return msg;
- }
- @@ -10031,10 +10031,10 @@
- if (explicitResult) {
- lcn ++;
- }
- - if (newlevel) {
- + if (newlevel >= 0) {
- lcn += 2;
- }
- - if (newcode) {
- + if (newcode >= 0) {
- lcn += 2;
- }
- @@ -10050,20 +10050,20 @@
- lignore = cignore = 0;
- for (i=0, j=0; i<numOptions; i+=2) {
- if (0 == strcmp(TclGetString(lv[i]), "-level")) {
- - if (newlevel) {
- + if (newlevel >= 0) {
- lvn[j++] = lv[i];
- - lvn[j++] = newlevel;
- - newlevel = NULL;
- + lvn[j++] = Tcl_NewIntObj(newlevel);
- + newlevel = -1;
- lignore = 1;
- continue;
- } else if (lignore) {
- continue;
- }
- } else if (0 == strcmp(TclGetString(lv[i]), "-code")) {
- - if (newcode) {
- + if (newcode >= 0) {
- lvn[j++] = lv[i];
- - lvn[j++] = newcode;
- - newcode = NULL;
- + lvn[j++] = Tcl_NewIntObj (newcode);
- + newcode = -1;
- cignore = 1;
- continue;
- } else if (cignore) {
- @@ -10078,6 +10078,8 @@
- lvn[j++] = lv[i];
- lvn[j++] = lv[i+1];
- }
- + if (newlevel >= 0) {Tcl_Panic ("Defined newlevel not used in rewrite");}
- + if (newcode >= 0) {Tcl_Panic ("Defined newcode not used in rewrite");}
- if (explicitResult) {
- lvn[j++] = lv[i];