From b541bbc3b70e0ab71edd12c00b498928c720a856 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 20 Aug 2009 08:31:16 +0000 Subject: Close off memory leak in [lsort]. --- ChangeLog | 1 + generic/tclCmdIL.c | 142 +++++++++++++++++++++++++---------------------------- 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 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 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++; } -- cgit v0.12