From c8ff4cae81a4a80f22f1b6ceb2475b2483e31592 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 31 May 2023 14:12:12 +0000 Subject: Use TclDuplicatePureObj() in stead of TclListObjCopy() where appropriate. Backported from 9.0 --- generic/tclBasic.c | 6 +- generic/tclCmdAH.c | 48 ++++++++----- generic/tclCmdIL.c | 169 +++++++++++++++++++++++++------------------ generic/tclEnsemble.c | 6 +- generic/tclEvent.c | 6 +- generic/tclExecute.c | 24 +++++-- generic/tclIOGT.c | 6 +- generic/tclIORChan.c | 14 ++-- generic/tclInt.h | 3 +- generic/tclListObj.c | 72 ++++--------------- generic/tclObj.c | 154 +++++++++++++++++++++++++++++++++------ generic/tclUtil.c | 194 ++++++++++++++++++++++++++------------------------ generic/tclVar.c | 16 ++++- 13 files changed, 436 insertions(+), 282 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b7bc311..7754f71 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -6658,7 +6658,11 @@ TclNREvalObjEx( */ Tcl_IncrRefCount(objPtr); - listPtr = TclListObjCopy(interp, objPtr); + listPtr = TclDuplicatePureObj(interp, objPtr, &tclListType); + if (!listPtr) { + Tcl_DecrRefCount(objPtr); + return TCL_ERROR; + } Tcl_IncrRefCount(listPtr); if (word != INT_MIN) { diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 89c556a..59b5ee0 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -26,14 +26,14 @@ struct ForeachState { Tcl_Obj *bodyPtr; /* The script body of the command. */ - int bodyIdx; /* The argument index of the body. */ - int j, maxj; /* Number of loop iterations. */ - int numLists; /* Count of value lists. */ - int *index; /* Array of value list indices. */ - int *varcList; /* # loop variables per list. */ + Tcl_Size bodyIdx; /* The argument index of the body. */ + Tcl_Size j, maxj; /* Number of loop iterations. */ + Tcl_Size numLists; /* Count of value lists. */ + Tcl_Size *index; /* Array of value list indices. */ + Tcl_Size *varcList; /* # loop variables per list. */ Tcl_Obj ***varvList; /* Array of var name lists. */ Tcl_Obj **vCopyList; /* Copies of var name list arguments. */ - int *argcList; /* Array of value list sizes. */ + Tcl_Size *argcList; /* Array of value list sizes. */ Tcl_Obj ***argvList; /* Array of value lists. */ Tcl_Obj **aCopyList; /* Copies of value list arguments. */ Tcl_Obj *resultList; /* List of result values from the loop body, @@ -658,7 +658,7 @@ EncodingConvertfromObjCmd( Tcl_Obj *data; /* Byte array to convert */ Tcl_DString ds; /* Buffer to hold the string */ Tcl_Encoding encoding; /* Encoding to use */ - int length; /* Length of the byte array being converted */ + Tcl_Size length; /* Length of the byte array being converted */ const char *bytesPtr; /* Pointer to the first byte of the array */ int flags; int result; @@ -764,7 +764,7 @@ EncodingConverttoObjCmd( Tcl_Obj *data; /* String to convert */ Tcl_DString ds; /* Buffer to hold the byte array */ Tcl_Encoding encoding; /* Encoding to use */ - int length; /* Length of the string being converted */ + Tcl_Size length; /* Length of the string being converted */ const char *stringPtr; /* Pointer to the first byte of the string */ int result; int flags; @@ -2198,7 +2198,7 @@ PathSplitCmd( Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } - res = Tcl_FSSplitPath(objv[1], (int *)NULL); + res = Tcl_FSSplitPath(objv[1], (Tcl_Size *)NULL); if (res == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": no such file or directory", @@ -2873,7 +2873,8 @@ EachloopCmd( { int numLists = (objc-2) / 2; struct ForeachState *statePtr; - int i, j, result; + int i, result; + Tcl_Size j; if (objc < 4 || (objc%2 != 0)) { Tcl_WrongNumArgs(interp, 1, objv, @@ -2897,16 +2898,16 @@ EachloopCmd( */ statePtr = (struct ForeachState *)TclStackAlloc(interp, - sizeof(struct ForeachState) + 3 * numLists * sizeof(int) + sizeof(struct ForeachState) + 3 * numLists * sizeof(Tcl_Size) + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *))); memset(statePtr, 0, - sizeof(struct ForeachState) + 3 * numLists * sizeof(int) + sizeof(struct ForeachState) + 3 * numLists * sizeof(Tcl_Size) + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *))); statePtr->varvList = (Tcl_Obj ***) (statePtr + 1); statePtr->argvList = statePtr->varvList + numLists; statePtr->vCopyList = (Tcl_Obj **) (statePtr->argvList + numLists); statePtr->aCopyList = statePtr->vCopyList + numLists; - statePtr->index = (int *) (statePtr->aCopyList + numLists); + statePtr->index = (Tcl_Size *) (statePtr->aCopyList + numLists); statePtr->varcList = statePtr->index + numLists; statePtr->argcList = statePtr->varcList + numLists; @@ -2927,13 +2928,18 @@ EachloopCmd( for (i=0 ; ivCopyList[i] = TclListObjCopy(interp, objv[1+i*2]); - if (statePtr->vCopyList[i] == NULL) { + statePtr->vCopyList[i] = TclDuplicatePureObj( + interp, objv[1+i*2], &tclListType); + if (!statePtr->vCopyList[i]) { result = TCL_ERROR; goto done; } - TclListObjLengthM(NULL, statePtr->vCopyList[i], + result = TclListObjLengthM(interp, statePtr->vCopyList[i], &statePtr->varcList[i]); + if (result != TCL_OK) { + result = TCL_ERROR; + goto done; + } if (statePtr->varcList[i] < 1) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s varlist is empty", @@ -2959,13 +2965,17 @@ EachloopCmd( statePtr->argcList[i] = TclArithSeriesObjLength(statePtr->aCopyList[i]); } else { /* List values */ - statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]); - if (statePtr->aCopyList[i] == NULL) { + statePtr->aCopyList[i] = TclDuplicatePureObj( + interp, objv[2+i*2], &tclListType); + if (!statePtr->aCopyList[i]) { result = TCL_ERROR; goto done; } - TclListObjGetElementsM(NULL, statePtr->aCopyList[i], + result = TclListObjGetElementsM(interp, statePtr->aCopyList[i], &statePtr->argcList[i], &statePtr->argvList[i]); + if (result != TCL_OK) { + goto done; + } } /* account for variable <> value mismatch */ j = statePtr->argcList[i] / statePtr->varcList[i]; diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 383cec4..5379871 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -205,7 +205,7 @@ static const EnsembleImplMap defaultInfoMap[] = { int Tcl_IfObjCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -215,7 +215,7 @@ Tcl_IfObjCmd( int TclNRIfObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -238,13 +238,13 @@ TclNRIfObjCmd( TclNewObj(boolObj); Tcl_NRAddCallback(interp, IfConditionCallback, INT2PTR(objc), - (ClientData) objv, INT2PTR(1), boolObj); + (void *) objv, INT2PTR(1), boolObj); return Tcl_NRExprObj(interp, objv[1], boolObj); } static int IfConditionCallback( - ClientData data[], + void *data[], Tcl_Interp *interp, int result) { @@ -388,7 +388,7 @@ IfConditionCallback( int Tcl_IncrObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -469,7 +469,7 @@ TclInitInfoCmd( static int InfoArgsCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -532,7 +532,7 @@ InfoArgsCmd( static int InfoBodyCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -593,7 +593,7 @@ InfoBodyCmd( static int InfoCmdCountCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -635,7 +635,7 @@ InfoCmdCountCmd( static int InfoCommandsCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -912,7 +912,7 @@ InfoCommandsCmd( static int InfoCompleteCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -949,7 +949,7 @@ InfoCompleteCmd( static int InfoDefaultCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1032,7 +1032,7 @@ InfoDefaultCmd( static int InfoErrorStackCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1081,7 +1081,7 @@ InfoErrorStackCmd( int TclInfoExistsCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1126,7 +1126,7 @@ TclInfoExistsCmd( static int InfoFrameCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1466,7 +1466,7 @@ TclInfoFrame( static int InfoFunctionsCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1531,7 +1531,7 @@ InfoFunctionsCmd( static int InfoHostnameCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1577,7 +1577,7 @@ InfoHostnameCmd( static int InfoLevelCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1651,7 +1651,7 @@ InfoLevelCmd( static int InfoLibraryCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1698,7 +1698,7 @@ InfoLibraryCmd( static int InfoLoadedCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1746,7 +1746,7 @@ InfoLoadedCmd( static int InfoNameOfExecutableCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1782,7 +1782,7 @@ InfoNameOfExecutableCmd( static int InfoPatchLevelCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1829,7 +1829,7 @@ InfoPatchLevelCmd( static int InfoProcsCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2016,7 +2016,7 @@ InfoProcsCmd( static int InfoScriptCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2064,7 +2064,7 @@ InfoScriptCmd( static int InfoSharedlibCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2102,7 +2102,7 @@ InfoSharedlibCmd( static int InfoTclVersionCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2145,7 +2145,7 @@ InfoTclVersionCmd( static int InfoCmdTypeCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2196,7 +2196,7 @@ InfoCmdTypeCmd( int Tcl_JoinObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ @@ -2318,7 +2318,7 @@ Tcl_JoinObjCmd( int Tcl_LassignObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2334,7 +2334,7 @@ Tcl_LassignObjCmd( return TCL_ERROR; } - listCopyPtr = TclListObjCopy(interp, objv[1]); + listCopyPtr = TclDuplicatePureObj(interp, objv[1], &tclListType); if (listCopyPtr == NULL) { return TCL_ERROR; } @@ -2401,7 +2401,7 @@ Tcl_LassignObjCmd( int Tcl_LindexObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2459,7 +2459,7 @@ Tcl_LindexObjCmd( int Tcl_LinsertObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2499,7 +2499,10 @@ Tcl_LinsertObjCmd( listPtr = objv[1]; if (Tcl_IsShared(listPtr)) { - listPtr = TclListObjCopy(NULL, listPtr); + listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType); + if (!listPtr) { + return TCL_ERROR; + } } if ((objc == 4) && (index == len)) { @@ -2542,7 +2545,7 @@ Tcl_LinsertObjCmd( int Tcl_ListObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) @@ -2578,7 +2581,7 @@ Tcl_ListObjCmd( int Tcl_LlengthObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) @@ -2627,7 +2630,7 @@ Tcl_LlengthObjCmd( int Tcl_LpopObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) @@ -2686,7 +2689,10 @@ Tcl_LpopObjCmd( if (objc == 2) { if (Tcl_IsShared(listPtr)) { - listPtr = TclListObjCopy(NULL, listPtr); + listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType); + if (!listPtr) { + return TCL_ERROR; + } } result = Tcl_ListObjReplace(interp, listPtr, listLen - 1, 1, 0, NULL); if (result != TCL_OK) { @@ -2729,7 +2735,7 @@ Tcl_LpopObjCmd( int Tcl_LrangeObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) @@ -2811,7 +2817,7 @@ LremoveIndexCompare( int Tcl_LremoveObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2819,6 +2825,7 @@ Tcl_LremoveObjCmd( Tcl_Size i, idxc, prevIdx, first, num; Tcl_Size *idxv, listLen; Tcl_Obj *listObj; + int copied = 0, status = TCL_OK; /* * Parse the arguments. @@ -2841,10 +2848,10 @@ Tcl_LremoveObjCmd( } idxv = (Tcl_Size *)Tcl_Alloc((objc - 2) * sizeof(*idxv)); for (i = 2; i < objc; i++) { - if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1, - &idxv[i - 2]) != TCL_OK) { - ckfree(idxv); - return TCL_ERROR; + status = (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1, + &idxv[i - 2]) != TCL_OK); + if (status != TCL_OK) { + goto done; } } @@ -2862,7 +2869,12 @@ Tcl_LremoveObjCmd( */ if (Tcl_IsShared(listObj)) { - listObj = TclListObjCopy(NULL, listObj); + listObj = TclDuplicatePureObj(interp, listObj, &tclListType); + if (!listObj) { + status = TCL_ERROR; + goto done; + } + copied = 1; } num = 0; first = listLen; @@ -2897,18 +2909,28 @@ Tcl_LremoveObjCmd( * and we're only ever contracting that list. */ - (void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL); + status = Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL); + if (status != TCL_OK) { + goto done; + } listLen -= num; num = 1; first = idx; } } if (num != 0) { - (void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL); + status = Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL); + if (status != TCL_OK) { + if (copied) { + Tcl_DecrRefCount(listObj); + } + goto done; + } } - ckfree(idxv); Tcl_SetObjResult(interp, listObj); - return TCL_OK; +done: + ckfree(idxv); + return status; } /* @@ -2971,7 +2993,7 @@ Tcl_LrepeatObjCmd( if (elementCount && objc > LIST_MAX/elementCount) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "max length of a Tcl list (%d elements) exceeded", LIST_MAX)); + "max length of a Tcl list (%" TCL_SIZE_MODIFIER "d elements) exceeded", LIST_MAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } @@ -3045,7 +3067,7 @@ Tcl_LrepeatObjCmd( int Tcl_LreplaceObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3103,7 +3125,10 @@ Tcl_LreplaceObjCmd( listPtr = objv[1]; if (Tcl_IsShared(listPtr)) { - listPtr = TclListObjCopy(NULL, listPtr); + listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType); + if (!listPtr) { + return TCL_ERROR; + } } /* @@ -3146,7 +3171,7 @@ Tcl_LreplaceObjCmd( int Tcl_LreverseObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ @@ -3251,7 +3276,7 @@ Tcl_LreverseObjCmd( int Tcl_LsearchObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ @@ -3498,7 +3523,7 @@ Tcl_LsearchObjCmd( } if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (-index option item number %d)", j)); + "\n (-index option item number %" TCL_SIZE_MODIFIER "d)", j)); goto done; } sortInfo.indexv[j] = encoded; @@ -3630,7 +3655,7 @@ Tcl_LsearchObjCmd( * "did not match anything at all" result straight away. [Bug 1374778] */ - if (start > listc-1) { + if (start >= listc) { if (allMatches || inlineReturn) { Tcl_ResetResult(interp); } else { @@ -3921,7 +3946,7 @@ Tcl_LsearchObjCmd( Tcl_ListObjAppendElement(interp, listPtr, itemPtr); } } else if (returnSubindices) { - int j; + Tcl_Size j; TclNewIndexObj(itemPtr, i+groupOffset); for (j=0 ; j= b) - (a <= b)); } else { Tcl_Obj **objv, *paramObjv[2]; - int objc; + Tcl_Size objc; Tcl_Obj *objPtr1, *objPtr2; if (infoPtr->resultCode != TCL_OK) { @@ -5483,7 +5511,7 @@ SelectObjFromSublist( SortInfo *infoPtr) /* Information passed from the top-level * "lsearch" or "lsort" command. */ { - int i; + Tcl_Size i; /* * Quick check for case when no "-index" option is there. @@ -5499,7 +5527,8 @@ SelectObjFromSublist( */ for (i=0 ; iindexc ; i++) { - int listLen, index; + Tcl_Size listLen; + int index; Tcl_Obj *currentObj; if (TclListObjLengthM(infoPtr->interp, objPtr, &listLen) != TCL_OK) { @@ -5515,7 +5544,7 @@ SelectObjFromSublist( return NULL; } if (currentObj == NULL) { - if (index == (int)TCL_INDEX_NONE) { + if (index == TCL_INDEX_NONE) { index = TCL_INDEX_END - infoPtr->indexv[i]; Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf( "element end-%d missing from sublist \"%s\"", diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index b946a84..610198c 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -1900,7 +1900,11 @@ NsEnsembleImplementationCmdNR( TclListObjLengthM(NULL, prefixObj, &prefixObjc); if (objc == 2) { - copyPtr = TclListObjCopy(NULL, prefixObj); + copyPtr = TclDuplicatePureObj( + interp, prefixObj, &tclListType); + if (!copyPtr) { + return TCL_ERROR; + } } else { copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL); Tcl_ListObjAppendList(NULL, copyPtr, prefixObj); diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 5501721..5848728 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -243,7 +243,11 @@ HandleBgErrors( * support one handler setting another handler. */ - Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix); + Tcl_Obj *copyObj = TclDuplicatePureObj( + interp, assocPtr->cmdPrefix, &tclListType); + if (!copyObj) { + return; + } errPtr = assocPtr->firstBgPtr; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 3f7e209..59fb9a2 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4481,7 +4481,7 @@ TEBCresume( NEXT_INST_F(1, 0, 1); break; case INST_INFO_LEVEL_ARGS: { - Tcl_Size level; + int level; CallFrame *framePtr = iPtr->varFramePtr; CallFrame *rootFramePtr = iPtr->rootFramePtr; @@ -5580,7 +5580,7 @@ TEBCresume( { Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p; - int length3, endIdx; + Tcl_Size length3, endIdx; Tcl_Obj *value3Ptr; case INST_STR_REPLACE: @@ -5678,7 +5678,7 @@ TEBCresume( for (; ustring1 < end; ustring1++) { if ((*ustring1 == *ustring2) && /* Fix bug [69218ab7b]: restrict max compare length. */ - (end-ustring1 >= length2) && (length2==1 || + ((end-ustring1) >= length2) && (length2==1 || memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { @@ -6693,7 +6693,7 @@ TEBCresume( numVars = varListPtr->numVars; listVarPtr = LOCAL(listTmpIndex); - listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr); + listPtr = TclDuplicatePureObj(NULL, listVarPtr->value.objPtr, &tclListType); TclListObjGetElementsM(interp, listPtr, &listLen, &elements); valIndex = (iterNum * numVars); @@ -6790,7 +6790,11 @@ TEBCresume( goto gotError; } if (Tcl_IsShared(listPtr)) { - objPtr = TclListObjCopy(NULL, listPtr); + objPtr = TclDuplicatePureObj( + interp, listPtr, &tclListType); + if (!objPtr) { + goto gotError; + } Tcl_IncrRefCount(objPtr); Tcl_DecrRefCount(listPtr); OBJ_AT_DEPTH(listTmpDepth) = objPtr; @@ -6852,6 +6856,7 @@ TEBCresume( */ if (iterNum < iterMax) { + int status; /* * Set the variables and jump back to run the body */ @@ -6865,7 +6870,12 @@ TEBCresume( numVars = varListPtr->numVars; listPtr = OBJ_AT_DEPTH(listTmpDepth); - TclListObjGetElementsM(interp, listPtr, &listLen, &elements); + status = TclListObjGetElementsM( + interp, listPtr, &listLen, &elements); + if (status != TCL_OK) { + goto gotError; + } + valIndex = (iterNum * numVars); for (j = 0; j < numVars; j++) { @@ -9358,7 +9368,7 @@ IllegalExprOperandType( } if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) { - int numBytes; + Tcl_Size numBytes; const char *bytes = TclGetStringFromObj(opndPtr, &numBytes); if (numBytes == 0) { diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index 93442a1..77ea6bd 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -387,7 +387,11 @@ ExecuteCallback( unsigned char *resBuf; Tcl_InterpState state = NULL; int res = TCL_OK; - Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command); + Tcl_Obj *command = TclDuplicatePureObj( + interp, dataPtr->command, &tclListType); + if (!command) { + return TCL_ERROR; + } Tcl_Interp *eval = dataPtr->interp; Tcl_Preserve(eval); diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index ccb61fc..3b1573b 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -2285,8 +2285,10 @@ NewReflectedChannel( rcPtr->mode = mode; rcPtr->interest = 0; /* Initially no interest registered */ - /* ASSERT: cmdpfxObj is a Tcl List */ - rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj); + rcPtr->cmd = TclDuplicatePureObj(interp, cmdpfxObj, &tclListType); + if (!rcPtr->cmd) { + return NULL; + } Tcl_IncrRefCount(rcPtr->cmd); rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL); while (mn <= (int)METH_WRITE) { @@ -2423,8 +2425,10 @@ InvokeTclMethod( * before the channel id. */ - cmd = TclListObjCopy(NULL, rcPtr->cmd); - + cmd = TclDuplicatePureObj(NULL, rcPtr->cmd, &tclListType); + if (!cmd) { + return TCL_ERROR; + } Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj); Tcl_ListObjAppendElement(NULL, cmd, methObj); Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name); @@ -3145,7 +3149,7 @@ ForwardProc( } else { ForwardSetObjError(paramPtr, resObj); } - paramPtr->input.toRead = -1; + paramPtr->input.toRead = TCL_IO_FAILURE; } else { /* * Process a regular result. diff --git a/generic/tclInt.h b/generic/tclInt.h index e40c5bc..e2c0bde 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3126,6 +3126,8 @@ MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp, Tcl_Namespace *ensembleNamespacePtr, int flags); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); MODULE_SCOPE void TclDeleteNamespaceChildren(Namespace *nsPtr); +MODULE_SCOPE Tcl_Obj *TclDuplicatePureObj(Tcl_Interp *interp, + Tcl_Obj * objPtr, const Tcl_ObjType *typPtr); MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp, const char *dict, Tcl_Size dictLength, const char **elementPtr, const char **nextPtr, @@ -3255,7 +3257,6 @@ MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, /* TIP #280 */ MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, Tcl_Size line, int n, int *lines, Tcl_Obj *const *elems); -MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr); MODULE_SCOPE int TclListObjAppendElements(Tcl_Interp *interp, Tcl_Obj *toObj, Tcl_Size elemCount, Tcl_Obj *const elemObjv[]); diff --git a/generic/tclListObj.c b/generic/tclListObj.c index bb13961..d3e4f02 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -40,7 +40,7 @@ #ifdef ENABLE_LIST_ASSERTS -#define LIST_ASSERT(cond_) assert(cond_) /* TODO - is there a Tcl-specific one? */ +#define LIST_ASSERT(cond_) assert(cond_) /* * LIST_INDEX_ASSERT is to catch errors with negative indices and counts * being passed AFTER validation. On Tcl9 length types are unsigned hence @@ -782,7 +782,8 @@ ListStoreNew( } if (storePtr == NULL) { if (flags & LISTREP_PANIC_ON_FAIL) { - Tcl_Panic("list creation failed: unable to alloc %u bytes", + Tcl_Panic("list creation failed: unable to alloc %" TCL_SIZE_MODIFIER + "d bytes", LIST_SIZE(objc)); } return NULL; @@ -826,7 +827,8 @@ ListStoreNew( * * ListStoreReallocate -- * - * Reallocates the memory for a ListStore. + * Reallocates the memory for a ListStore allocating extra for + * possible future growth. * * Results: * Pointer to the ListStore which may be the same as storePtr or pointer @@ -841,23 +843,23 @@ ListStoreNew( *------------------------------------------------------------------------ */ ListStore * -ListStoreReallocate (ListStore *storePtr, Tcl_Size numSlots) +ListStoreReallocate (ListStore *storePtr, Tcl_Size needed) { - Tcl_Size newCapacity; + Tcl_Size capacity; ListStore *newStorePtr; - newCapacity = ListStoreUpSize(numSlots); + capacity = ListStoreUpSize(needed); newStorePtr = - (ListStore *)attemptckrealloc(storePtr, LIST_SIZE(newCapacity)); + (ListStore *)attemptckrealloc(storePtr, LIST_SIZE(capacity)); if (newStorePtr == NULL) { - newCapacity = numSlots; + capacity = needed; newStorePtr = (ListStore *)attemptckrealloc(storePtr, - LIST_SIZE(newCapacity)); + LIST_SIZE(capacity)); if (newStorePtr == NULL) return NULL; } /* Only the capacity has changed, fix it in the header */ - newStorePtr->numAllocated = newCapacity; + newStorePtr->numAllocated = capacity; return newStorePtr; } @@ -1341,50 +1343,6 @@ Tcl_SetListObj( } /* - *---------------------------------------------------------------------- - * - * TclListObjCopy -- - * - * Makes a "pure list" copy of a list value. This provides for the C - * level a counterpart of the [lrange $list 0 end] command, while using - * internals details to be as efficient as possible. - * - * Results: - * Normally returns a pointer to a new Tcl_Obj, that contains the same - * list value as *listPtr does. The returned Tcl_Obj has a refCount of - * zero. If *listPtr does not hold a list, NULL is returned, and if - * interp is non-NULL, an error message is recorded there. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -TclListObjCopy( - Tcl_Interp *interp, /* Used to report errors if not NULL. */ - Tcl_Obj *listObj) /* List object for which an element array is - * to be returned. */ -{ - Tcl_Obj *copyObj; - - if (!TclHasInternalRep(listObj, &tclListType)) { - if (TclHasInternalRep(listObj,&tclArithSeriesType)) { - return TclArithSeriesObjCopy(interp, listObj); - } - if (SetListFromAny(interp, listObj) != TCL_OK) { - return NULL; - } - } - - TclNewObj(copyObj); - TclInvalidateStringRep(copyObj); - DupListInternalRep(listObj, copyObj); - return copyObj; -} - -/* *------------------------------------------------------------------------ * * ListRepRange -- @@ -2587,7 +2545,7 @@ TclLindexList( * implementation does not. */ - indexListCopy = TclListObjCopy(NULL, argObj); + indexListCopy = TclDuplicatePureObj(NULL, argObj, &tclListType); if (indexListCopy == NULL) { /* * The argument is neither an index nor a well-formed list. @@ -2672,7 +2630,7 @@ TclLindexFlat( * while we are still using it. See test lindex-8.4. */ - sublistCopy = TclListObjCopy(interp, listObj); + sublistCopy = TclDuplicatePureObj(interp, listObj, &tclListType); Tcl_DecrRefCount(listObj); listObj = NULL; @@ -2765,7 +2723,7 @@ TclLsetList( return TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj); } - indexListCopy = TclListObjCopy(NULL, indexArgObj); + indexListCopy = TclDuplicatePureObj(NULL, indexArgObj, &tclListType); if (indexListCopy == NULL) { /* * indexArgPtr designates something that is neither an index nor a diff --git a/generic/tclObj.c b/generic/tclObj.c index 933138c..3d56a18 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -58,7 +58,7 @@ char tclEmptyString = '\0'; * for sanity checking purposes. */ -typedef struct ObjData { +typedef struct { Tcl_Obj *objPtr; /* The pointer to the allocated Tcl_Obj. */ const char *file; /* The name of the source file calling this * function; used for debugging. */ @@ -205,6 +205,9 @@ static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void UpdateStringOfBignum(Tcl_Obj *objPtr); static int GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int copy, mp_int *bignumValue); +static int SetDuplicatePureObj(Tcl_Interp *interp, + Tcl_Obj *dupPtr, Tcl_Obj *objPtr, + const Tcl_ObjType *typePtr); /* * Prototypes for the array hash key methods. @@ -341,12 +344,12 @@ typedef struct ResolvedCmdName { * it's possible that the cmd's containing * namespace was deleted and a new one created * at the same address). */ - int refNsCmdEpoch; /* Value of the referencing namespace's + Tcl_Size refNsCmdEpoch; /* Value of the referencing namespace's * cmdRefEpoch when the pointer was cached. * Before using the cached pointer, we check * if the namespace's epoch was incremented; * if so, this cached pointer is invalid. */ - int cmdEpoch; /* Value of the command's cmdEpoch when this + Tcl_Size cmdEpoch; /* Value of the command's cmdEpoch when this * pointer was cached. Before using the cached * pointer, we check if the cmd's epoch was * incremented; if so, the cmd was renamed, @@ -567,7 +570,7 @@ TclGetContLineTable(void) ContLineLoc * TclContinuationsEnter( Tcl_Obj *objPtr, - int num, + Tcl_Size num, int *loc) { int newEntry; @@ -634,7 +637,8 @@ TclContinuationsEnterDerived( int start, int *clNext) { - int length, end, num; + Tcl_Size length; + int end, num; int *wordCLLast = clNext; /* @@ -876,7 +880,7 @@ Tcl_AppendAllObjTypes( { Tcl_HashEntry *hPtr; Tcl_HashSearch search; - int numElems; + Tcl_Size numElems; /* * Get the test for a valid list out of the way first. @@ -1012,7 +1016,7 @@ TclDbDumpActiveObjects( tablePtr = tsdPtr->objThreadMap; if (tablePtr != NULL) { - fprintf(outFile, "total objects: %d\n", tablePtr->numEntries); + fprintf(outFile, "total objects: %" TCL_SIZE_MODIFIER "d\n", tablePtr->numEntries); for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr); @@ -1349,16 +1353,16 @@ TclFreeObj( * sure we do not accept a second free when falling from 0 to -1. * Skip that possibility so any double free will trigger the panic. */ - objPtr->refCount = -1; + objPtr->refCount = TCL_INDEX_NONE; /* * Invalidate the string rep first so we can use the bytes value for our * pointer chain, and signal an obj deletion (as opposed to shimmering) - * with 'length == -1'. + * with 'length == TCL_INDEX_NONE'. */ TclInvalidateStringRep(objPtr); - objPtr->length = -1; + objPtr->length = TCL_INDEX_NONE; if (ObjDeletePending(context)) { PushObjToDelete(context, objPtr); @@ -1426,7 +1430,7 @@ TclFreeObj( */ TclInvalidateStringRep(objPtr); - objPtr->length = -1; + objPtr->length = TCL_INDEX_NONE; if (!objPtr->typePtr || !objPtr->typePtr->freeIntRepProc) { /* @@ -1528,7 +1532,7 @@ int TclObjBeingDeleted( Tcl_Obj *objPtr) { - return (objPtr->length == -1); + return (objPtr->length == TCL_INDEX_NONE); } /* @@ -1539,6 +1543,14 @@ TclObjBeingDeleted( * Create and return a new object that is a duplicate of the argument * object. * + * TclDuplicatePureObj -- + * Like Tcl_DuplicateObj, except that it converts the duplicate to the + * specifid typ, does not duplicate the 'bytes' + * field unless it is necessary, i.e. the duplicated Tcl_Obj provides no + * updateStringProc. This can avoid an expensive memory allocation since + * the data in the 'bytes' field of each Tcl_Obj must reside in allocated + * memory. + * * Results: * The return value is a pointer to a newly created Tcl_Obj. This object * has reference count 0 and the same type, if any, as the source object @@ -1590,6 +1602,104 @@ Tcl_DuplicateObj( return dupPtr; } + +/* + *---------------------------------------------------------------------- + * + * Tcl_DuplicatePureObj -- + * + * Duplicates a Tcl_Obj and converts the internal representation of the + * duplicate to the given type, changing neither the 'bytes' field + * nor the internal representation of the original object, and without + * duplicating the bytes field unless necessary, i.e. unless the + * duplicate provides no updateStringProc after conversion. This can + * avoid an expensive memory allocation since the data in the 'bytes' + * field of each Tcl_Obj must reside in allocated memory. + * + * Results: + * A pointer to a newly-created Tcl_Obj or NULL if there was an error. + * This object has reference count 0. Also: + * + *---------------------------------------------------------------------- + */ +int SetDuplicatePureObj( + Tcl_Interp *interp, + Tcl_Obj *dupPtr, + Tcl_Obj *objPtr, + const Tcl_ObjType *typePtr) +{ + char *bytes = objPtr->bytes; + int status = TCL_OK; + + TclInvalidateStringRep(dupPtr); + assert(dupPtr->typePtr == NULL); + + if (objPtr->typePtr && objPtr->typePtr->dupIntRepProc) { + objPtr->typePtr->dupIntRepProc(objPtr, dupPtr); + } else { + dupPtr->internalRep = objPtr->internalRep; + dupPtr->typePtr = objPtr->typePtr; + } + + if (typePtr != NULL && dupPtr->typePtr != typePtr) { + if (bytes) { + dupPtr->bytes = bytes; + dupPtr->length = objPtr->length; + } + /* borrow bytes from original object */ + status = Tcl_ConvertToType(interp, dupPtr, typePtr); + if (bytes) { + dupPtr->bytes = NULL; + dupPtr->length = 0; + } + if (status != TCL_OK) { + return status; + } + } + + /* tclStringType is treated as a special case because a Tcl_Obj having this + * type can not always update the string representation. This happens, for + * example, when Tcl_GetCharLength() converts the internal representation + * to tclStringType in order to store the number of characters, but does + * not store enough information to generate the string representation. + * + * Perhaps in the future this can be remedied and this special treatment + * removed. + */ + + + if (bytes && (dupPtr->typePtr == NULL + || dupPtr->typePtr->updateStringProc == NULL + || typePtr == &tclStringType + ) + ) { + TclInitStringRep(dupPtr, bytes, objPtr->length); + } + return status; +} + +Tcl_Obj * +TclDuplicatePureObj( + Tcl_Interp *interp, + Tcl_Obj *objPtr, + const Tcl_ObjType *typePtr +) /* The object to duplicate. */ +{ + int status; + Tcl_Obj *dupPtr; + + TclNewObj(dupPtr); + status = SetDuplicatePureObj(interp, dupPtr, objPtr, typePtr); + if (status == TCL_OK) { + return dupPtr; + } else { + Tcl_DecrRefCount(dupPtr); + return NULL; + } +} + + + void TclSetDuplicateObj( Tcl_Obj *dupPtr, @@ -1913,8 +2023,8 @@ Tcl_HasStringRep( * * Tcl_StoreInternalRep -- * - * This function is called to set the object's internal - * representation to match a particular type. + * Called to set the object's internal representation to match a + * particular type. * * It is the caller's responsibility to guarantee that * the value of the submitted internalrep is in agreement with @@ -2175,7 +2285,7 @@ Tcl_GetBoolFromObj( if (interp) { TclNewObj(objPtr); TclParseNumber(interp, objPtr, (flags & TCL_NULL_OK) - ? "boolean value or \"\"" : "boolean value", NULL, -1, NULL, 0); + ? "boolean value or \"\"" : "boolean value", NULL, TCL_INDEX_NONE, NULL, 0); Tcl_DecrRefCount(objPtr); } return TCL_ERROR; @@ -2301,7 +2411,7 @@ TclSetBooleanFromAny( badBoolean: if (interp != NULL) { - int length; + Tcl_Size length; const char *str = Tcl_GetStringFromObj(objPtr, &length); Tcl_Obj *msg; @@ -2320,8 +2430,8 @@ ParseBoolean( { int newBool; char lowerCase[6]; - const char *str = TclGetString(objPtr); - size_t i, length = objPtr->length; + Tcl_Size i, length; + const char *str = TclGetStringFromObj(objPtr, &length); if ((length == 0) || (length > 5)) { /* @@ -4103,7 +4213,7 @@ Tcl_IncrRefCount( * Decrements the reference count of the object. * * Results: - * None. + * The storage for objPtr may be freed. * *---------------------------------------------------------------------- */ @@ -4452,7 +4562,7 @@ TclCompareObjKeys( Tcl_HashEntry *hPtr) /* Existing key to compare. */ { Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr; - Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue; + Tcl_Obj *objPtr2 = (Tcl_Obj *)hPtr->key.oneWordValue; const char *p1, *p2; size_t l1, l2; @@ -4541,7 +4651,7 @@ TclHashObjKey( void *keyPtr) /* Key from which to compute hash value. */ { Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; - int length; + Tcl_Size length; const char *string = Tcl_GetStringFromObj(objPtr, &length); TCL_HASH_TYPE result = 0; @@ -4956,7 +5066,7 @@ Tcl_RepresentationCmd( * "1872361827361287" */ - descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d," + descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_SIZE_MODIFIER "d," " object pointer at %p", objv[1]->typePtr ? objv[1]->typePtr->name : "pure string", objv[1]->refCount, objv[1]); diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 7bd55e2..30ae39a 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -114,9 +114,9 @@ static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr); static int GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, size_t endValue, Tcl_WideInt *widePtr); static int FindElement(Tcl_Interp *interp, const char *string, - int stringLength, const char *typeStr, + Tcl_Size stringLength, const char *typeStr, const char *typeCode, const char **elementPtr, - const char **nextPtr, int *sizePtr, + const char **nextPtr, Tcl_Size *sizePtr, int *literalPtr); /* * The following is the Tcl object type definition for an object that @@ -391,13 +391,13 @@ static const Tcl_ObjType endOffsetType = { *---------------------------------------------------------------------- */ -int +Tcl_Size TclMaxListLength( const char *bytes, - int numBytes, + Tcl_Size numBytes, const char **endPtr) { - int count = 0; + Tcl_Size count = 0; if ((numBytes == 0) || ((numBytes == TCL_INDEX_NONE) && (*bytes == '\0'))) { /* Empty string case - quick exit */ @@ -500,13 +500,13 @@ TclFindElement( const char *list, /* Points to the first byte of a string * containing a Tcl list with zero or more * elements (possibly in braces). */ - int listLength, /* Number of bytes in the list's string. */ + Tcl_Size listLength, /* Number of bytes in the list's string. */ const char **elementPtr, /* Where to put address of first significant * character in first element of list. */ const char **nextPtr, /* Fill in with location of character just * after all white space following end of * argument (next arg or end of list). */ - int *sizePtr, /* If non-zero, fill in with size of + Tcl_Size *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr @@ -528,14 +528,14 @@ TclFindDictElement( * containing a Tcl dictionary with zero or * more keys and values (possibly in * braces). */ - int dictLength, /* Number of bytes in the dict's string. */ + Tcl_Size dictLength, /* Number of bytes in the dict's string. */ const char **elementPtr, /* Where to put address of first significant * character in the first element (i.e., key * or value) of dict. */ const char **nextPtr, /* Fill in with location of character just * after all white space following end of * element (next arg or end of list). */ - int *sizePtr, /* If non-zero, fill in with size of + Tcl_Size *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr @@ -557,7 +557,7 @@ FindElement( * containing a Tcl list or dictionary with * zero or more elements (possibly in * braces). */ - int stringLength, /* Number of bytes in the string. */ + Tcl_Size stringLength, /* Number of bytes in the string. */ const char *typeStr, /* The name of the type of thing we are * parsing, for error messages. */ const char *typeCode, /* The type code for thing we are parsing, for @@ -567,7 +567,7 @@ FindElement( const char **nextPtr, /* Fill in with location of character just * after all white space following end of * argument (next arg or end of list/dict). */ - int *sizePtr, /* If non-zero, fill in with size of + Tcl_Size *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr @@ -579,10 +579,10 @@ FindElement( const char *p = string; const char *elemStart; /* Points to first byte of first element. */ const char *limit; /* Points just after list/dict's last byte. */ - int openBraces = 0; /* Brace nesting level during parse. */ + Tcl_Size openBraces = 0; /* Brace nesting level during parse. */ int inQuotes = 0; - int size = 0; - int numChars; + Tcl_Size size = 0; + Tcl_Size numChars; int literal = 1; const char *p2; @@ -790,21 +790,21 @@ FindElement( *---------------------------------------------------------------------- */ -int +Tcl_Size TclCopyAndCollapse( - int count, /* Number of byte to copy from src. */ + Tcl_Size count, /* Number of byte to copy from src. */ const char *src, /* Copy from here... */ char *dst) /* ... to here. */ { - int newCount = 0; + Tcl_Size newCount = 0; while (count > 0) { char c = *src; if (c == '\\') { char buf[4] = ""; - int numRead; - int backslashCount = TclParseBackslash(src, count, &numRead, buf); + Tcl_Size numRead; + Tcl_Size backslashCount = TclParseBackslash(src, count, &numRead, buf); memcpy(dst, buf, backslashCount); dst += backslashCount; @@ -857,14 +857,15 @@ Tcl_SplitList( Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, no error message is left. */ const char *list, /* Pointer to string with list structure. */ - int *argcPtr, /* Pointer to location to fill in with the + Tcl_Size *argcPtr, /* Pointer to location to fill in with the * number of elements in the list. */ const char ***argvPtr) /* Pointer to place to store pointer to array * of pointers to list elements. */ { const char **argv, *end, *element; char *p; - int length, size, i, result, elSize; + int result; + Tcl_Size length, size, i, elSize; /* * Allocate enough space to work in. A (const char *) for each (possible) @@ -897,7 +898,7 @@ Tcl_SplitList( ckfree(argv); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "internal error in Tcl_SplitList", TCL_INDEX_NONE)); + "internal error in Tcl_SplitList", -1)); Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList", NULL); } @@ -941,7 +942,7 @@ Tcl_SplitList( *---------------------------------------------------------------------- */ -int +Tcl_Size Tcl_ScanElement( const char *src, /* String to convert to list element. */ int *flagPtr) /* Where to store information to guide @@ -973,15 +974,15 @@ Tcl_ScanElement( *---------------------------------------------------------------------- */ -int +Tcl_Size Tcl_ScanCountedElement( const char *src, /* String to convert to Tcl list element. */ - int length, /* Number of bytes in src, or TCL_INDEX_NONE. */ + Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */ int *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { char flags = CONVERT_ANY; - int numBytes = TclScanElement(src, length, &flags); + Tcl_Size numBytes = TclScanElement(src, length, &flags); *flagPtr = flags; return numBytes; @@ -1020,17 +1021,17 @@ Tcl_ScanCountedElement( TCL_HASH_TYPE TclScanElement( const char *src, /* String to convert to Tcl list element. */ - int length, /* Number of bytes in src, or TCL_INDEX_NONE. */ + Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */ char *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { const char *p = src; - int nestingLevel = 0; /* Brace nesting count */ + Tcl_Size nestingLevel = 0; /* Brace nesting count */ int forbidNone = 0; /* Do not permit CONVERT_NONE mode. Something * needs protection or escape. */ int requireEscape = 0; /* Force use of CONVERT_ESCAPE mode. For some * reason bare or brace-quoted form fails. */ - int extra = 0; /* Count of number of extra bytes needed for + Tcl_Size extra = 0; /* Count of number of extra bytes needed for * formatted element, assuming we use escape * sequences in formatting. */ TCL_HASH_TYPE bytesNeeded; /* Buffer length computed to complete the @@ -1094,8 +1095,7 @@ TclScanElement( braceCount++; #endif /* COMPAT */ extra++; /* Escape '}' => '\}' */ - nestingLevel--; - if (nestingLevel < 0) { + if (nestingLevel-- < 1) { /* * Unbalanced braces! Cannot format with brace quoting. */ @@ -1324,7 +1324,7 @@ TclScanElement( *---------------------------------------------------------------------- */ -int +Tcl_Size Tcl_ConvertElement( const char *src, /* Source information for list element. */ char *dst, /* Place to put list-ified element. */ @@ -1354,14 +1354,14 @@ Tcl_ConvertElement( *---------------------------------------------------------------------- */ -int +Tcl_Size Tcl_ConvertCountedElement( const char *src, /* Source information for list element. */ - int length, /* Number of bytes in src, or TCL_INDEX_NONE. */ + Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { - int numBytes = TclConvertElement(src, length, dst, flags); + Tcl_Size numBytes = TclConvertElement(src, length, dst, flags); dst[numBytes] = '\0'; return numBytes; } @@ -1387,10 +1387,10 @@ Tcl_ConvertCountedElement( *---------------------------------------------------------------------- */ -int +Tcl_Size TclConvertElement( const char *src, /* Source information for list element. */ - int length, /* Number of bytes in src, or TCL_INDEX_NONE. */ + Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { @@ -1466,7 +1466,7 @@ TclConvertElement( } *p = '}'; p++; - return p - dst; + return (p - dst); } /* conversion == CONVERT_ESCAPE or CONVERT_MASK */ @@ -1529,7 +1529,7 @@ TclConvertElement( continue; case '\0': if (length == TCL_INDEX_NONE) { - return p - dst; + return (p - dst); } /* @@ -1545,7 +1545,7 @@ TclConvertElement( *p = *src; p++; } - return p - dst; + return (p - dst); } /* @@ -1570,7 +1570,7 @@ TclConvertElement( char * Tcl_Merge( - int argc, /* How many strings to merge. */ + Tcl_Size argc, /* How many strings to merge. */ const char *const *argv) /* Array of string values. */ { #define LOCAL_SIZE 64 @@ -1687,14 +1687,14 @@ Tcl_Backslash( *---------------------------------------------------------------------- */ -int +Tcl_Size TclTrimRight( const char *bytes, /* String to be trimmed... */ - int numBytes, /* ...and its length in bytes */ + Tcl_Size numBytes, /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (bytes[numBytes] == '\0'). */ const char *trim, /* String of trim characters... */ - int numTrim) /* ...and its length in bytes */ + Tcl_Size numTrim) /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (trim[numTrim] == '\0'). */ { @@ -1712,7 +1712,7 @@ TclTrimRight( do { const char *q = trim; - int pInc = 0, bytesLeft = numTrim; + Tcl_Size pInc = 0, bytesLeft = numTrim; pp = Tcl_UtfPrev(p, bytes); do { @@ -1766,14 +1766,14 @@ TclTrimRight( *---------------------------------------------------------------------- */ -int +Tcl_Size TclTrimLeft( const char *bytes, /* String to be trimmed... */ - int numBytes, /* ...and its length in bytes */ + Tcl_Size numBytes, /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (bytes[numBytes] == '\0'). */ const char *trim, /* String of trim characters... */ - int numTrim) /* ...and its length in bytes */ + Tcl_Size numTrim) /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (trim[numTrim] == '\0'). */ { @@ -1790,16 +1790,16 @@ TclTrimLeft( */ do { - int pInc = TclUtfToUCS4(p, &ch1); + Tcl_Size pInc = TclUtfToUCS4(p, &ch1); const char *q = trim; - int bytesLeft = numTrim; + Tcl_Size bytesLeft = numTrim; /* * Inner loop: scan trim string for match to current character. */ do { - int qInc = TclUtfToUCS4(q, &ch2); + Tcl_Size qInc = TclUtfToUCS4(q, &ch2); if (ch1 == ch2) { break; @@ -1840,19 +1840,19 @@ TclTrimLeft( *---------------------------------------------------------------------- */ -int +Tcl_Size TclTrim( const char *bytes, /* String to be trimmed... */ - int numBytes, /* ...and its length in bytes */ + Tcl_Size numBytes, /* ...and its length in bytes */ /* Calls in this routine * rely on (bytes[numBytes] == '\0'). */ const char *trim, /* String of trim characters... */ - int numTrim, /* ...and its length in bytes */ + Tcl_Size numTrim, /* ...and its length in bytes */ /* Calls in this routine * rely on (trim[numTrim] == '\0'). */ - int *trimRightPtr) /* Offset from the end of the string. */ + Tcl_Size *trimRightPtr) /* Offset from the end of the string. */ { - int trimLeft = 0, trimRight = 0; + Tcl_Size trimLeft = 0, trimRight = 0; /* Empty strings -> nothing to do */ if ((numBytes > 0) && (numTrim > 0)) { @@ -1904,10 +1904,10 @@ TclTrim( char * Tcl_Concat( - int argc, /* Number of strings to concatenate. */ + Tcl_Size argc, /* Number of strings to concatenate. */ const char *const *argv) /* Array of strings to concatenate. */ { - int i, needSpace = 0, bytesNeeded = 0; + Tcl_Size i, needSpace = 0, bytesNeeded = 0; char *result, *p; /* @@ -1930,6 +1930,10 @@ Tcl_Concat( Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded"); } } + + /* + * All element bytes + (argc - 1) spaces + 1 terminating NULL. + */ if (bytesNeeded + argc - 1 < 0) { /* * Panic test could be tighter, but not going to bother for this @@ -1939,14 +1943,10 @@ Tcl_Concat( Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded"); } - /* - * All element bytes + (argc - 1) spaces + 1 terminating NULL. - */ - result = (char *)ckalloc(bytesNeeded + argc); for (p = result, i = 0; i < argc; i++) { - int triml, trimr, elemLength; + Tcl_Size triml, trimr, elemLength; const char *element; element = argv[i]; @@ -2004,10 +2004,11 @@ Tcl_Concat( Tcl_Obj * Tcl_ConcatObj( - int objc, /* Number of objects to concatenate. */ + Tcl_Size objc, /* Number of objects to concatenate. */ Tcl_Obj *const objv[]) /* Array of objects to concatenate. */ { - int i, elemLength, needSpace = 0, bytesNeeded = 0; + int needSpace = 0; + Tcl_Size i, bytesNeeded = 0, elemLength; const char *element; Tcl_Obj *objPtr, *resPtr; @@ -2018,7 +2019,7 @@ Tcl_ConcatObj( */ for (i = 0; i < objc; i++) { - int length; + Tcl_Size length; objPtr = objv[i]; if (TclListObjIsCanonical(objPtr)) { @@ -2050,7 +2051,11 @@ Tcl_ConcatObj( goto slow; } } else { - resPtr = TclListObjCopy(NULL, objPtr); + resPtr = TclDuplicatePureObj( + NULL, objPtr, &tclListType); + if (!resPtr) { + return NULL; + } } } if (!resPtr) { @@ -2086,7 +2091,7 @@ Tcl_ConcatObj( Tcl_SetObjLength(resPtr, 0); for (i = 0; i < objc; i++) { - int triml, trimr; + Tcl_Size triml, trimr; element = TclGetStringFromObj(objv[i], &elemLength); @@ -2406,11 +2411,11 @@ Tcl_StringCaseMatch( int TclByteArrayMatch( const unsigned char *string,/* String. */ - int strLen, /* Length of String */ + Tcl_Size strLen, /* Length of String */ const unsigned char *pattern, /* Pattern, which may contain special * characters. */ - int ptnLen, /* Length of Pattern */ + Tcl_Size ptnLen, /* Length of Pattern */ TCL_UNUSED(int) /*flags*/) { const unsigned char *stringEnd, *patternEnd; @@ -2587,7 +2592,8 @@ TclStringMatchObj( int flags) /* Only TCL_MATCH_NOCASE should be passed, or * 0. */ { - int match, length, plen; + int match; + Tcl_Size length, plen; /* * Promote based on the type of incoming object. @@ -2667,11 +2673,11 @@ Tcl_DStringAppend( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ const char *bytes, /* String to append. If length is * < 0 then this must be null-terminated. */ - int length) /* Number of bytes from "bytes" to append. If + Tcl_Size length) /* Number of bytes from "bytes" to append. If * < 0, then append all of bytes, up to null * at end. */ { - int newSize; + Tcl_Size newSize; if (length < 0) { length = strlen(bytes); @@ -2692,18 +2698,18 @@ Tcl_DStringAppend( memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { - int index = TCL_INDEX_NONE; + Tcl_Size offset = -1; /* See [16896d49fd] */ if (bytes >= dsPtr->string && bytes <= dsPtr->string + dsPtr->length) { - index = bytes - dsPtr->string; + offset = bytes - dsPtr->string; } dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl); - if (index >= 0) { - bytes = dsPtr->string + index; + if (offset >= 0) { + bytes = dsPtr->string + offset; } } } @@ -2734,7 +2740,7 @@ TclDStringAppendObj( Tcl_DString *dsPtr, Tcl_Obj *objPtr) { - int length; + Tcl_Size length; char *bytes = TclGetStringFromObj(objPtr, &length); return Tcl_DStringAppend(dsPtr, bytes, length); @@ -2776,7 +2782,8 @@ Tcl_DStringAppendElement( char *dst = dsPtr->string + dsPtr->length; int needSpace = TclNeedSpace(dsPtr->string, dst); char flags = 0; - int quoteHash = 1, newSize; + int quoteHash = 1; + Tcl_Size newSize; if (needSpace) { /* @@ -2878,9 +2885,9 @@ Tcl_DStringAppendElement( void Tcl_DStringSetLength( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ - int length) /* New length for dynamic string. */ + Tcl_Size length) /* New length for dynamic string. */ { - int newsize; + Tcl_Size newsize; if (length < 0) { length = 0; @@ -3569,15 +3576,14 @@ TclNeedSpace( *---------------------------------------------------------------------- */ -int +Tcl_Size TclFormatInt( char *buffer, /* Points to the storage into which the * formatted characters are written. */ Tcl_WideInt n) /* The integer to format. */ { - Tcl_WideUInt intVal; - int i = 0; - int numFormatted, j; + Tcl_WideUInt intVal; + int i = 0, numFormatted, j; static const char digits[] = "0123456789"; /* @@ -3704,9 +3710,8 @@ Tcl_GetIntForIndex( * errors. */ Tcl_Obj *objPtr, /* Points to an object containing either "end" * or an integer. */ - int endValue, /* The value to be stored at "indexPtr" if - * "objPtr" holds "end". */ - int *indexPtr) /* Location filled in with an integer + Tcl_Size endValue, /* The value corresponding to the "end" index */ + Tcl_Size *indexPtr) /* Location filled in with an integer * representing an index. May be NULL.*/ { Tcl_WideInt wide; @@ -3727,6 +3732,7 @@ Tcl_GetIntForIndex( } return TCL_OK; } + /* *---------------------------------------------------------------------- * @@ -3770,7 +3776,7 @@ GetEndOffsetFromObj( while ((irPtr = TclFetchInternalRep(objPtr, &endOffsetType)) == NULL) { Tcl_ObjInternalRep ir; - int length; + Tcl_Size length; const char *bytes = TclGetStringFromObj(objPtr, &length); if (*bytes != 'e') { @@ -4103,10 +4109,10 @@ TclIndexEncode( *---------------------------------------------------------------------- */ -int +Tcl_Size TclIndexDecode( int encoded, /* Value to decode */ - int endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ + Tcl_Size endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ { if (encoded > TCL_INDEX_END) { return encoded; @@ -4375,7 +4381,7 @@ TclGetProcessGlobalValue( Tcl_Obj *value = NULL; Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; - int epoch = pgvPtr->epoch; + Tcl_Size epoch = pgvPtr->epoch; if (pgvPtr->encoding) { Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL); @@ -4606,7 +4612,7 @@ int TclReToGlob( Tcl_Interp *interp, const char *reStr, - int reStrLen, + Tcl_Size reStrLen, Tcl_DString *dsPtr, int *exactPtr, int *quantifiersFoundPtr) @@ -4799,7 +4805,7 @@ TclReToGlob( invalidGlob: if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL); } Tcl_DStringFree(dsPtr); diff --git a/generic/tclVar.c b/generic/tclVar.c index 65430f9..e79bfc1 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -3222,7 +3222,10 @@ ArrayForNRCmd( * loop) don't vanish. */ - varListObj = TclListObjCopy(NULL, objv[1]); + varListObj = TclDuplicatePureObj(interp, objv[1], &tclListType); + if (!varListObj) { + return TCL_ERROR; + } scriptObj = objv[3]; Tcl_IncrRefCount(scriptObj); @@ -3301,7 +3304,10 @@ ArrayForLoopCallback( goto arrayfordone; } - TclListObjGetElementsM(NULL, varListObj, &varc, &varv); + result = TclListObjGetElementsM(NULL, varListObj, &varc, &varv); + if (result != TCL_OK) { + goto arrayfordone; + } if (Tcl_ObjSetVar2(interp, varv[0], NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; @@ -4191,7 +4197,11 @@ ArraySetCmd( * the loop and return an error. */ - copyListObj = TclListObjCopy(NULL, arrayElemObj); + copyListObj = + TclDuplicatePureObj(interp, arrayElemObj, &tclListType); + if (!copyListObj) { + return TCL_ERROR; + } for (i=0 ; i