summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclBasic.c6
-rw-r--r--generic/tclCmdAH.c48
-rw-r--r--generic/tclCmdIL.c169
-rw-r--r--generic/tclEnsemble.c6
-rw-r--r--generic/tclEvent.c6
-rw-r--r--generic/tclExecute.c24
-rw-r--r--generic/tclIOGT.c6
-rw-r--r--generic/tclIORChan.c14
-rw-r--r--generic/tclInt.h3
-rw-r--r--generic/tclListObj.c72
-rw-r--r--generic/tclObj.c154
-rw-r--r--generic/tclUtil.c194
-rw-r--r--generic/tclVar.c16
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 ; i<numLists ; i++) {
/* List */
/* Variables */
- statePtr->vCopyList[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<sortInfo.indexc ; j++) {
@@ -3944,7 +3969,7 @@ Tcl_LsearchObjCmd(
Tcl_SetObjResult(interp, listPtr);
} else if (!inlineReturn) {
if (returnSubindices) {
- int j;
+ Tcl_Size j;
TclNewIndexObj(itemPtr, index+groupOffset);
for (j=0 ; j<sortInfo.indexc ; j++) {
@@ -4010,7 +4035,7 @@ Tcl_LsearchObjCmd(
int
Tcl_LsetObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
@@ -4206,7 +4231,7 @@ SequenceIdentifyArgument(
int
Tcl_LseqObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -4582,7 +4607,7 @@ Tcl_LsortObjCmd(
sortInfo.isIncreasing = 1;
break;
case LSORT_INDEX: {
- int sortindex;
+ Tcl_Size sortindex;
Tcl_Obj **indexv;
if (i == objc-2) {
@@ -4719,7 +4744,7 @@ Tcl_LsortObjCmd(
* 1675116]
*/
- listObj = TclListObjCopy(interp, listObj);
+ listObj = TclDuplicatePureObj(interp ,listObj, &tclListType);
if (listObj == NULL) {
sortInfo.resultCode = TCL_ERROR;
goto done;
@@ -5015,7 +5040,7 @@ Tcl_LsortObjCmd(
int
Tcl_LeditObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
@@ -5024,10 +5049,10 @@ Tcl_LeditObjCmd(
Tcl_Obj *finalValuePtr; /* Value finally assigned to the variable. */
int createdNewObj;
int result;
- int first;
- int last;
- int listLen;
- int numToDelete;
+ Tcl_Size first;
+ Tcl_Size last;
+ Tcl_Size listLen;
+ Tcl_Size numToDelete;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -5076,7 +5101,10 @@ Tcl_LeditObjCmd(
}
if (Tcl_IsShared(listPtr)) {
- listPtr = TclListObjCopy(NULL, listPtr);
+ listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType);
+ if (!listPtr) {
+ return TCL_ERROR;
+ }
createdNewObj = 1;
} else {
createdNewObj = 0;
@@ -5265,7 +5293,7 @@ SortCompare(
order = ((a >= 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 ; i<infoPtr->indexc ; 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<elemLen ; i+=2) {
Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
elemPtrs[i], TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);
generated by cgit v0.12 at 2024-11-16 11:37:46 (GMT)