summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2009-08-20 08:31:16 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2009-08-20 08:31:16 (GMT)
commitb541bbc3b70e0ab71edd12c00b498928c720a856 (patch)
tree4455ffde1f61c6df7dc3f6d0a079efd4b97250b6
parent13295adc2421cdeacbac60fd9556f3ab27c609d8 (diff)
downloadtcl-b541bbc3b70e0ab71edd12c00b498928c720a856.zip
tcl-b541bbc3b70e0ab71edd12c00b498928c720a856.tar.gz
tcl-b541bbc3b70e0ab71edd12c00b498928c720a856.tar.bz2
Close off memory leak in [lsort].
-rw-r--r--ChangeLog1
-rw-r--r--generic/tclCmdIL.c142
2 files changed, 69 insertions, 74 deletions
diff --git a/ChangeLog b/ChangeLog
index c52582e..6285475 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,7 @@
* generic/tclCmdIL.c (TclNRIfObjCmd): [Bug 2823276]: Make [if]
NRE-safe on all arguments when interpreted.
+ (Tcl_LsortObjCmd): Close off memory leak.
2009-08-19 Donal K. Fellows <dkf@users.sf.net>
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 274d9b8..e10a899 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -3,7 +3,7 @@
*
* This file contains the top-level command routines for most of the Tcl
* built-in commands whose names begin with the letters I through L. It
- * contains only commands in the generic core (i.e. those that don't
+ * contains only commands in the generic core (i.e., those that don't
* depend much upon UNIX facilities).
*
* Copyright (c) 1987-1993 The Regents of the University of California.
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdIL.c,v 1.169 2009/08/19 23:23:22 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.170 2009/08/20 08:31:16 dkf Exp $
*/
#include "tclInt.h"
@@ -677,8 +677,8 @@ InfoCommandsCmd(
Namespace *dummy1NsPtr, *dummy2NsPtr;
pattern = TclGetString(objv[1]);
- TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL, 0,
- &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
+ TclGetNamespaceForQualName(interp, pattern, NULL, 0, &nsPtr,
+ &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
if (nsPtr != NULL) { /* We successfully found the pattern's ns. */
specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
@@ -991,6 +991,7 @@ InfoDefaultCmd(
Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
} else {
Tcl_Obj *nullObjPtr = Tcl_NewObj();
+
valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
nullObjPtr, 0);
if (valueObjPtr == NULL) {
@@ -1172,6 +1173,7 @@ TclInfoFrame(
CmdFrame *framePtr) /* Frame to get info for. */
{
Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *tmpObj;
Tcl_Obj *lv[20]; /* Keep uptodate when more keys are added to
* the dict. */
int lc = 0;
@@ -1182,12 +1184,9 @@ TclInfoFrame(
static const char *const typeString[TCL_LOCATION_LAST] = {
"eval", "eval", "eval", "precompiled", "source", "proc"
};
- Tcl_Obj *tmpObj;
-
- Proc *procPtr =
- framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
+ Proc *procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
- /*
+ /*
* Pull the information and construct the dictionary to return, as list.
* Regarding use of the CmdFrame fields see tclInt.h, and its definition.
*/
@@ -1242,9 +1241,8 @@ TclInfoFrame(
* Execution of bytecode. Talk to the BC engine to fill out the frame.
*/
- CmdFrame *fPtr;
+ CmdFrame *fPtr = TclStackAlloc(interp, sizeof(CmdFrame));
- fPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
*fPtr = *framePtr;
/*
@@ -1313,13 +1311,13 @@ TclInfoFrame(
Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;
if (namePtr) {
+ char *procName = Tcl_GetHashKey(namePtr->tablePtr, namePtr);
+ char *nsName = procPtr->cmdPtr->nsPtr->fullName;
+
/*
* This is a regular command.
*/
- char *procName = Tcl_GetHashKey(namePtr->tablePtr, namePtr);
- char *nsName = procPtr->cmdPtr->nsPtr->fullName;
-
ADD_PAIR("proc", Tcl_NewStringObj(nsName, -1));
if (strcmp(nsName, "::") != 0) {
@@ -1762,9 +1760,8 @@ InfoProcsCmd(
Namespace *dummy1NsPtr, *dummy2NsPtr;
pattern = TclGetString(objv[1]);
- TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
- /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
- &simplePattern);
+ TclGetNamespaceForQualName(interp, pattern, NULL, /*flags*/ 0, &nsPtr,
+ &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
if (nsPtr != NULL) { /* We successfully found the pattern's ns. */
specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
@@ -2118,20 +2115,22 @@ Tcl_LassignObjCmd(
objc -= 2;
objv += 2;
while (code == TCL_OK && objc > 0 && listObjc > 0) {
- if (NULL == Tcl_ObjSetVar2(interp, *objv++, NULL,
- *listObjv++, TCL_LEAVE_ERR_MSG)) {
+ if (Tcl_ObjSetVar2(interp, *objv++, NULL, *listObjv++,
+ TCL_LEAVE_ERR_MSG) == NULL) {
code = TCL_ERROR;
}
- objc--; listObjc--;
+ objc--;
+ listObjc--;
}
if (code == TCL_OK && objc > 0) {
Tcl_Obj *emptyObj;
+
TclNewObj(emptyObj);
Tcl_IncrRefCount(emptyObj);
while (code == TCL_OK && objc-- > 0) {
- if (NULL == Tcl_ObjSetVar2(interp, *objv++, NULL,
- emptyObj, TCL_LEAVE_ERR_MSG)) {
+ if (Tcl_ObjSetVar2(interp, *objv++, NULL, emptyObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
code = TCL_ERROR;
}
}
@@ -2419,7 +2418,7 @@ Tcl_LrangeObjCmd(
return result;
}
if (last >= listLen) {
- last = (listLen - 1);
+ last = listLen - 1;
}
if (first > last) {
@@ -2450,7 +2449,7 @@ Tcl_LrangeObjCmd(
}
/*
- * This one is not conditioned on (first>0) in order to preserve the
+ * This one is not conditioned on (first > 0) in order to preserve the
* string-canonizing effect of [lrange 0 end].
*/
@@ -2646,10 +2645,10 @@ Tcl_LreplaceObjCmd(
return TCL_ERROR;
}
if (last >= listLen) {
- last = (listLen - 1);
+ last = listLen - 1;
}
if (first <= last) {
- numToDelete = (last - first + 1);
+ numToDelete = last - first + 1;
} else {
numToDelete = 0;
}
@@ -2672,7 +2671,7 @@ Tcl_LreplaceObjCmd(
* optimize this case away.
*/
- Tcl_ListObjReplace(NULL, listPtr, first, numToDelete, objc-4, &(objv[4]));
+ Tcl_ListObjReplace(NULL, listPtr, first, numToDelete, objc-4, objv+4);
/*
* Set the interpreter's object result.
@@ -2718,7 +2717,7 @@ Tcl_LreverseObjCmd(
}
/*
- * If the list is empty, just return it [Bug 1876793]
+ * If the list is empty, just return it. [Bug 1876793]
*/
if (!elemc) {
@@ -2732,7 +2731,7 @@ Tcl_LreverseObjCmd(
makeNewReversedList:
resultObj = Tcl_NewListObj(elemc, NULL);
- listPtr = (List *) resultObj->internalRep.twoPtrValue.ptr1;
+ listPtr = resultObj->internalRep.twoPtrValue.ptr1;
listPtr->elemCount = elemc;
dataArray = &listPtr->elements;
@@ -3494,8 +3493,7 @@ Tcl_LsetObjCmd(
* Look up the list variable's value.
*/
- listPtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
- TCL_LEAVE_ERR_MSG);
+ listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
if (listPtr == NULL) {
return TCL_ERROR;
}
@@ -3569,6 +3567,12 @@ Tcl_LsortObjCmd(
SortElement *elementArray, *elementPtr;
SortInfo sortInfo; /* Information about this sort that needs to
* be passed to the comparison function. */
+# define NUM_LISTS 30
+ SortElement *subList[NUM_LISTS+1];
+ /* This array holds pointers to temporary
+ * lists built during the merge sort. Element
+ * i of the array holds a list of length
+ * 2**i. */
static const char *const switches[] = {
"-ascii", "-command", "-decreasing", "-dictionary", "-increasing",
"-index", "-indices", "-integer", "-nocase", "-real", "-stride",
@@ -3580,13 +3584,6 @@ Tcl_LsortObjCmd(
LSORT_NOCASE, LSORT_REAL, LSORT_STRIDE, LSORT_UNIQUE
};
- /*
- * The subList array below holds pointers to temporary lists built during
- * the merge sort. Element i of the array holds a list of length 2**i.
- */
-# define NUM_LISTS 30
- SortElement *subList[NUM_LISTS+1];
-
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list");
return TCL_ERROR;
@@ -3611,21 +3608,20 @@ Tcl_LsortObjCmd(
for (i = 1; i < objc-1; i++) {
if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
&index) != TCL_OK) {
- return TCL_ERROR;
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
}
switch ((enum Lsort_Switches) index) {
case LSORT_ASCII:
sortInfo.sortMode = SORTMODE_ASCII;
break;
case LSORT_COMMAND:
- if (i == (objc-2)) {
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
+ if (i == objc-2) {
Tcl_AppendResult(interp,
"\"-command\" option must be followed "
"by comparison command", NULL);
- return TCL_ERROR;
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
}
sortInfo.sortMode = SORTMODE_COMMAND;
cmdPtr = objv[i+1];
@@ -3643,10 +3639,18 @@ Tcl_LsortObjCmd(
case LSORT_INDEX: {
Tcl_Obj **indices;
+ /* === START SPECIAL CASE ===
+ *
+ * When reviewing code flow in this function, note that from here
+ * to the line a bit below (END SPECIAL CASE) the contents of the
+ * indexc and indexv fields of the sortInfo structure may not be
+ * matched, so jumping to the done2 label to exit is wrong.
+ */
+
if (sortInfo.indexc > 1) {
ckfree((char *) sortInfo.indexv);
}
- if (i == (objc-2)) {
+ if (i == objc-2) {
Tcl_AppendResult(interp, "\"-index\" option must be "
"followed by list index", NULL);
return TCL_ERROR;
@@ -3660,6 +3664,8 @@ Tcl_LsortObjCmd(
&indices) != TCL_OK) {
return TCL_ERROR;
}
+ /* === END SPECIAL CASE === */
+
switch (sortInfo.indexc) {
case 0:
sortInfo.indexv = NULL;
@@ -3681,12 +3687,10 @@ Tcl_LsortObjCmd(
for (j=0 ; j<sortInfo.indexc ; j++) {
if (TclGetIntForIndexM(interp, indices[j], SORTIDX_END,
&sortInfo.indexv[j]) != TCL_OK) {
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (-index option item number %d)", j));
- return TCL_ERROR;
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
}
}
i++;
@@ -3708,28 +3712,22 @@ Tcl_LsortObjCmd(
indices = 1;
break;
case LSORT_STRIDE:
- if (i == (objc-2)) {
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
+ if (i == objc-2) {
Tcl_AppendResult(interp,
"\"-stride\" option must be followed by stride length",
NULL);
- return TCL_ERROR;
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
}
if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) {
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- return TCL_ERROR;
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
}
if (groupSize < 2) {
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
Tcl_AppendResult(interp, "stride length must be at least 2",
NULL);
- return TCL_ERROR;
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
}
group = 1;
i++;
@@ -3754,10 +3752,8 @@ Tcl_LsortObjCmd(
listObj = TclListObjCopy(interp, listObj);
if (listObj == NULL) {
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- return TCL_ERROR;
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
}
/*
@@ -3774,10 +3770,8 @@ Tcl_LsortObjCmd(
TclDecrRefCount(listObj);
Tcl_IncrRefCount(newObjPtr);
TclDecrRefCount(newObjPtr);
- if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
- }
- return TCL_ERROR;
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
}
Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
sortInfo.compareCmdPtr = newCommandPtr;
@@ -3997,6 +3991,7 @@ Tcl_LsortObjCmd(
TclDecrRefCount(listObj);
sortInfo.compareCmdPtr = NULL;
}
+ done2:
if (sortInfo.indexc > 1) {
ckfree((char *) sortInfo.indexv);
}
@@ -4186,8 +4181,7 @@ SortCompare(
infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0);
if (infoPtr->resultCode != TCL_OK) {
- Tcl_AddErrorInfo(infoPtr->interp,
- "\n (-compare command)");
+ Tcl_AddErrorInfo(infoPtr->interp, "\n (-compare command)");
return 0;
}
@@ -4253,11 +4247,11 @@ DictionaryCompare(
*/
zeros = 0;
- while ((*right == '0') && (isdigit(UCHAR(right[1])))) {
+ while ((*right == '0') && isdigit(UCHAR(right[1]))) {
right++;
zeros--;
}
- while ((*left == '0') && (isdigit(UCHAR(left[1])))) {
+ while ((*left == '0') && isdigit(UCHAR(left[1]))) {
left++;
zeros++;
}