Close off memory leak in [lsort].

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++;
 	    }