summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c306
1 files changed, 205 insertions, 101 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 9491bca..f012549 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -334,6 +334,7 @@ static Tcl_ObjCmdProc TestFindFirstCmd;
static Tcl_ObjCmdProc TestFindLastCmd;
static Tcl_ObjCmdProc TestHashSystemHashCmd;
static Tcl_ObjCmdProc TestGetIntForIndexCmd;
+static Tcl_ObjCmdProc TestLutilCmd;
static Tcl_NRPostProc NREUnwind_callback;
static Tcl_ObjCmdProc TestNREUnwind;
@@ -722,6 +723,8 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateObjCommand(interp, "testapplylambda", TestApplyLambdaObjCmd,
NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testlutil", TestLutilCmd,
+ NULL, NULL);
if (TclObjTest_Init(interp) != TCL_OK) {
return TCL_ERROR;
@@ -924,7 +927,7 @@ TestasyncCmd(
break;
}
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], TCL_INDEX_NONE));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1));
Tcl_MutexUnlock(&asyncTestMutex);
return code;
} else if (strcmp(argv[1], "marklater") == 0) {
@@ -1208,8 +1211,8 @@ CmdDelProc1(
void *clientData) /* String to save. */
{
Tcl_DStringInit(&delString);
- Tcl_DStringAppend(&delString, "CmdDelProc1 ", TCL_INDEX_NONE);
- Tcl_DStringAppend(&delString, (char *) clientData, TCL_INDEX_NONE);
+ Tcl_DStringAppend(&delString, "CmdDelProc1 ", -1);
+ Tcl_DStringAppend(&delString, (char *) clientData, -1);
}
static void
@@ -1217,8 +1220,8 @@ CmdDelProc2(
void *clientData) /* String to save. */
{
Tcl_DStringInit(&delString);
- Tcl_DStringAppend(&delString, "CmdDelProc2 ", TCL_INDEX_NONE);
- Tcl_DStringAppend(&delString, (char *) clientData, TCL_INDEX_NONE);
+ Tcl_DStringAppend(&delString, "CmdDelProc2 ", -1);
+ Tcl_DStringAppend(&delString, (char *) clientData, -1);
}
/*
@@ -1263,7 +1266,7 @@ TestcmdtokenCmd(
nextCommandTokenRefId++;
refPtr->nextPtr = firstCommandTokenRef;
firstCommandTokenRef = refPtr;
- sprintf(buf, "%d", refPtr->id);
+ snprintf(buf, sizeof(buf), "%d", refPtr->id);
Tcl_AppendResult(interp, buf, NULL);
} else {
if (sscanf(argv[2], "%d", &id) != 1) {
@@ -1471,7 +1474,7 @@ ObjTraceProc(
const char *word = Tcl_GetString(objv[0]);
if (!strcmp(word, "Error")) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(command, TCL_INDEX_NONE));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1));
return TCL_ERROR;
} else if (!strcmp(word, "Break")) {
return TCL_BREAK;
@@ -1835,7 +1838,7 @@ TestdoubledigitsObjCmd(
type = types[type];
if (objc > 4) {
if (strcmp(Tcl_GetString(objv[4]), "shorten")) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", TCL_INDEX_NONE));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1));
return TCL_ERROR;
}
type |= TCL_DD_SHORTEST;
@@ -2032,7 +2035,23 @@ static int UtfExtWrapper(
int result;
int flags;
Tcl_Obj **flagObjs;
- int nflags;
+ Tcl_Size nflags;
+ static const struct {
+ const char *flagKey;
+ int flag;
+ } flagMap[] = {
+ {"start", TCL_ENCODING_START},
+ {"end", TCL_ENCODING_END},
+ {"stoponerror", TCL_ENCODING_STOPONERROR},
+ {"noterminate", TCL_ENCODING_NO_TERMINATE},
+ {"charlimit", TCL_ENCODING_CHAR_LIMIT},
+ {"profiletcl8", TCL_ENCODING_PROFILE_TCL8},
+ {"profilestrict", TCL_ENCODING_PROFILE_STRICT},
+ {"profilereplace", TCL_ENCODING_PROFILE_REPLACE},
+ {NULL, 0}
+ };
+ Tcl_Size i;
+ Tcl_WideInt wide;
if (objc < 7 || objc > 10) {
Tcl_WrongNumArgs(interp,
@@ -2051,21 +2070,6 @@ static int UtfExtWrapper(
return TCL_ERROR;
}
- struct {
- const char *flagKey;
- int flag;
- } flagMap[] = {
- {"start", TCL_ENCODING_START},
- {"end", TCL_ENCODING_END},
- {"stoponerror", TCL_ENCODING_STOPONERROR},
- {"noterminate", TCL_ENCODING_NO_TERMINATE},
- {"charlimit", TCL_ENCODING_CHAR_LIMIT},
- {"profiletcl8", TCL_ENCODING_PROFILE_TCL8},
- {"profilestrict", TCL_ENCODING_PROFILE_STRICT},
- {"profilereplace", TCL_ENCODING_PROFILE_REPLACE},
- {NULL, 0}
- };
- int i;
for (i = 0; i < nflags; ++i) {
int flag;
if (Tcl_GetIntFromObj(NULL, flagObjs[i], &flag) == TCL_OK) {
@@ -2086,7 +2090,6 @@ static int UtfExtWrapper(
}
/* Assumes state is integer if not "" */
- Tcl_WideInt wide;
if (Tcl_GetWideIntFromObj(interp, objv[5], &wide) == TCL_OK) {
encState = (Tcl_EncodingState)(size_t)wide;
encStatePtr = &encState;
@@ -2238,7 +2241,7 @@ TestencodingObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Encoding encoding;
- size_t length;
+ Tcl_Size length;
const char *string;
TclEncoding *encodingPtr;
static const char *const optionStrings[] = {
@@ -2266,7 +2269,7 @@ TestencodingObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "name toutfcmd fromutfcmd");
return TCL_ERROR;
}
- encodingPtr = (TclEncoding*)Tcl_Alloc(sizeof(TclEncoding));
+ encodingPtr = (TclEncoding *)Tcl_Alloc(sizeof(TclEncoding));
encodingPtr->interp = interp;
string = Tcl_GetStringFromObj(objv[3], &length);
@@ -2422,7 +2425,8 @@ TestevalexObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int length, flags;
+ int flags;
+ Tcl_Size length;
const char *script;
flags = 0;
@@ -2726,7 +2730,7 @@ ExitProcOdd(
char buf[16 + TCL_INTEGER_SPACE];
int len;
- sprintf(buf, "odd %d\n", (int)PTR2INT(clientData));
+ snprintf(buf, sizeof(buf), "odd %d\n", (int)PTR2INT(clientData));
len = strlen(buf);
if (len != (int) write(1, buf, len)) {
Tcl_Panic("ExitProcOdd: unable to write to stdout");
@@ -2740,7 +2744,7 @@ ExitProcEven(
char buf[16 + TCL_INTEGER_SPACE];
int len;
- sprintf(buf, "even %d\n", (int)PTR2INT(clientData));
+ snprintf(buf, sizeof(buf), "even %d\n", (int)PTR2INT(clientData));
len = strlen(buf);
if (len != (int) write(1, buf, len)) {
Tcl_Panic("ExitProcEven: unable to write to stdout");
@@ -2785,7 +2789,7 @@ TestexprlongCmd(
if (result != TCL_OK) {
return result;
}
- sprintf(buf, ": %ld", exprResult);
+ snprintf(buf, sizeof(buf), ": %ld", exprResult);
Tcl_AppendResult(interp, buf, NULL);
return TCL_OK;
}
@@ -2827,7 +2831,7 @@ TestexprlongobjCmd(
if (result != TCL_OK) {
return result;
}
- sprintf(buf, ": %ld", exprResult);
+ snprintf(buf, sizeof(buf), ": %ld", exprResult);
Tcl_AppendResult(interp, buf, NULL);
return TCL_OK;
}
@@ -3061,7 +3065,7 @@ TestgetassocdataCmd(
* TestgetplatformCmd --
*
* This procedure implements the "testgetplatform" command. It is
- * used to retrievel the value of the tclPlatform global variable.
+ * used to retrieve the value of the tclPlatform global variable.
*
* Results:
* A standard Tcl result.
@@ -3428,7 +3432,7 @@ TestlinkCmd(
}
}
if (argv[6][0] != 0) {
- tmp = Tcl_NewStringObj(argv[6], TCL_INDEX_NONE);
+ tmp = Tcl_NewStringObj(argv[6], -1);
if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
Tcl_DecrRefCount(tmp);
return TCL_ERROR;
@@ -3486,7 +3490,7 @@ TestlinkCmd(
}
if (argv[15][0]) {
Tcl_WideInt w;
- tmp = Tcl_NewStringObj(argv[15], TCL_INDEX_NONE);
+ tmp = Tcl_NewStringObj(argv[15], -1);
if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) {
Tcl_DecrRefCount(tmp);
return TCL_ERROR;
@@ -3536,7 +3540,7 @@ TestlinkCmd(
Tcl_UpdateLinkedVar(interp, "string");
}
if (argv[6][0] != 0) {
- tmp = Tcl_NewStringObj(argv[6], TCL_INDEX_NONE);
+ tmp = Tcl_NewStringObj(argv[6], -1);
if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
Tcl_DecrRefCount(tmp);
return TCL_ERROR;
@@ -3603,7 +3607,7 @@ TestlinkCmd(
}
if (argv[15][0]) {
Tcl_WideInt w;
- tmp = Tcl_NewStringObj(argv[15], TCL_INDEX_NONE);
+ tmp = Tcl_NewStringObj(argv[15], -1);
if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) {
Tcl_DecrRefCount(tmp);
return TCL_ERROR;
@@ -3660,7 +3664,8 @@ TestlinkarrayCmd(
TCL_LINK_FLOAT, TCL_LINK_DOUBLE, TCL_LINK_STRING, TCL_LINK_CHARS,
TCL_LINK_BINARY
};
- int typeIndex, readonly, i, size, length;
+ int typeIndex, readonly, i, size;
+ Tcl_Size length;
char *name, *arg;
Tcl_WideInt addr;
@@ -3710,7 +3715,7 @@ TestlinkarrayCmd(
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, objv[i++], &size) == TCL_ERROR) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong size value", TCL_INDEX_NONE));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong size value", -1));
return TCL_ERROR;
}
name = Tcl_GetString(objv[i++]);
@@ -3722,7 +3727,7 @@ TestlinkarrayCmd(
if (i < objc) {
if (Tcl_GetWideIntFromObj(interp, objv[i], &addr) == TCL_ERROR) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "wrong address value", TCL_INDEX_NONE));
+ "wrong address value", -1));
return TCL_ERROR;
}
} else {
@@ -3822,7 +3827,7 @@ TestlistrepCmd(
#define APPEND_FIELD(targetObj_, structPtr_, fld_) \
do { \
Tcl_ListObjAppendElement( \
- interp, (targetObj_), Tcl_NewStringObj(#fld_, TCL_INDEX_NONE)); \
+ interp, (targetObj_), Tcl_NewStringObj(#fld_, -1)); \
Tcl_ListObjAppendElement( \
interp, (targetObj_), Tcl_NewWideIntObj((structPtr_)->fld_)); \
} while (0)
@@ -3840,10 +3845,10 @@ TestlistrepCmd(
return TCL_ERROR;
}
ListObjGetRep(objv[2], &listRep);
- listRepObjs[0] = Tcl_NewStringObj("store", TCL_INDEX_NONE);
+ listRepObjs[0] = Tcl_NewStringObj("store", -1);
listRepObjs[1] = Tcl_NewListObj(12, NULL);
Tcl_ListObjAppendElement(
- interp, listRepObjs[1], Tcl_NewStringObj("memoryAddress", TCL_INDEX_NONE));
+ interp, listRepObjs[1], Tcl_NewStringObj("memoryAddress", -1));
Tcl_ListObjAppendElement(
interp, listRepObjs[1], Tcl_ObjPrintf("%p", listRep.storePtr));
APPEND_FIELD(listRepObjs[1], listRep.storePtr, firstUsed);
@@ -3852,11 +3857,11 @@ TestlistrepCmd(
APPEND_FIELD(listRepObjs[1], listRep.storePtr, refCount);
APPEND_FIELD(listRepObjs[1], listRep.storePtr, flags);
if (listRep.spanPtr) {
- listRepObjs[2] = Tcl_NewStringObj("span", TCL_INDEX_NONE);
+ listRepObjs[2] = Tcl_NewStringObj("span", -1);
listRepObjs[3] = Tcl_NewListObj(8, NULL);
Tcl_ListObjAppendElement(interp,
listRepObjs[3],
- Tcl_NewStringObj("memoryAddress", TCL_INDEX_NONE));
+ Tcl_NewStringObj("memoryAddress", -1));
Tcl_ListObjAppendElement(
interp, listRepObjs[3], Tcl_ObjPrintf("%p", listRep.spanPtr));
APPEND_FIELD(listRepObjs[3], listRep.spanPtr, spanStart);
@@ -3876,7 +3881,7 @@ TestlistrepCmd(
}
resultObj = Tcl_NewListObj(2, NULL);
Tcl_ListObjAppendElement(
- NULL, resultObj, Tcl_NewStringObj("LIST_SPAN_THRESHOLD", TCL_INDEX_NONE));
+ NULL, resultObj, Tcl_NewStringObj("LIST_SPAN_THRESHOLD", -1));
Tcl_ListObjAppendElement(
NULL, resultObj, Tcl_NewWideIntObj(LIST_SPAN_THRESHOLD));
break;
@@ -3950,7 +3955,7 @@ TestlocaleCmd(
}
locale = setlocale(lcTypes[index], locale);
if (locale) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, TCL_INDEX_NONE);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, -1);
}
return TCL_OK;
}
@@ -4005,7 +4010,8 @@ TestparserObjCmd(
Tcl_Obj *const objv[]) /* The argument objects. */
{
const char *script;
- int length, dummy;
+ Tcl_Size dummy;
+ int length;
Tcl_Parse parse;
if (objc != 3) {
@@ -4061,7 +4067,8 @@ TestexprparserObjCmd(
Tcl_Obj *const objv[]) /* The argument objects. */
{
const char *script;
- int length, dummy;
+ Tcl_Size dummy;
+ int length;
Tcl_Parse parse;
if (objc != 3) {
@@ -4123,7 +4130,7 @@ PrintParse(
Tcl_Obj *objPtr;
const char *typeString;
Tcl_Token *tokenPtr;
- size_t i;
+ Tcl_Size i;
objPtr = Tcl_GetObjResult(interp);
if (parsePtr->commentSize + 1 > 1) {
@@ -4137,7 +4144,7 @@ PrintParse(
Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize));
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewWideIntObj(parsePtr->numWords));
- for (i = 0; i < (size_t)parsePtr->numTokens; i++) {
+ for (i = 0; i < parsePtr->numTokens; i++) {
tokenPtr = &parsePtr->tokenPtr[i];
switch (tokenPtr->type) {
case TCL_TOKEN_EXPAND_WORD:
@@ -4172,7 +4179,7 @@ PrintParse(
break;
}
Tcl_ListObjAppendElement(NULL, objPtr,
- Tcl_NewStringObj(typeString, TCL_INDEX_NONE));
+ Tcl_NewStringObj(typeString, -1));
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(tokenPtr->start, tokenPtr->size));
Tcl_ListObjAppendElement(NULL, objPtr,
@@ -4250,7 +4257,8 @@ TestparsevarnameObjCmd(
Tcl_Obj *const objv[]) /* The argument objects. */
{
const char *script;
- int append, length, dummy;
+ int length, append;
+ Tcl_Size dummy;
Tcl_Parse parse;
if (objc != 4) {
@@ -4383,8 +4391,8 @@ TestregexpObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int i, indices, stringLength, match, about;
- Tcl_Size ii;
+ int i, indices, match, about;
+ Tcl_Size stringLength, ii;
int hasxflags, cflags, eflags;
Tcl_RegExp regExpr;
const char *string;
@@ -4501,7 +4509,7 @@ TestregexpObjCmd(
varName = Tcl_GetString(objv[2]);
TclRegExpRangeUniChar(regExpr, TCL_INDEX_NONE, &start, &end);
- sprintf(resinfo, "%" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d", start, end-1);
+ snprintf(resinfo, sizeof(resinfo), "%" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d", start, end-1);
value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
if (value == NULL) {
Tcl_AppendResult(interp, "couldn't set variable \"",
@@ -4515,7 +4523,7 @@ TestregexpObjCmd(
Tcl_RegExpGetInfo(regExpr, &info);
varName = Tcl_GetString(objv[2]);
- sprintf(resinfo, "%" TCL_Z_MODIFIER "d", info.extendStart);
+ snprintf(resinfo, sizeof(resinfo), "%" TCL_Z_MODIFIER "d", info.extendStart);
value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
if (value == NULL) {
Tcl_AppendResult(interp, "couldn't set variable \"",
@@ -4822,7 +4830,7 @@ TestsetplatformCmd(
* A standard Tcl result.
*
* Side effects:
- * When the packge given by argv[1] is loaded into an interpreter,
+ * When the package given by argv[1] is loaded into an interpreter,
* variable "x" in that interpreter is set to "loaded".
*
*----------------------------------------------------------------------
@@ -5288,7 +5296,7 @@ TestgetvarfullnameCmd(
*
* This procedure implements the "gettimes" command. It is used for
* computing the time needed for various basic operations such as reading
- * variables, allocating memory, sprintf, converting variables, etc.
+ * variables, allocating memory, snprintf, converting variables, etc.
*
* Results:
* A standard Tcl result.
@@ -5370,7 +5378,7 @@ GetTimesObjCmd(
/* TclGetString 100000 times */
fprintf(stderr, "Tcl_GetStringFromObj of \"12345\" 100000 times\n");
- objPtr = Tcl_NewStringObj("12345", TCL_INDEX_NONE);
+ objPtr = Tcl_NewStringObj("12345", -1);
Tcl_GetTime(&start);
for (i = 0; i < 100000; i++) {
(void) TclGetString(objPtr);
@@ -5407,15 +5415,15 @@ GetTimesObjCmd(
fprintf(stderr, " %.3f usec per Tcl_GetInt of \"12345\"\n",
timePer/100000);
- /* sprintf 100000 times */
- fprintf(stderr, "sprintf of 12345 100000 times\n");
+ /* snprintf 100000 times */
+ fprintf(stderr, "snprintf of 12345 100000 times\n");
Tcl_GetTime(&start);
for (i = 0; i < 100000; i++) {
- sprintf(newString, "%d", 12345);
+ snprintf(newString, sizeof(newString), "%d", 12345);
}
Tcl_GetTime(&stop);
timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
- fprintf(stderr, " %.3f usec per sprintf of 12345\n",
+ fprintf(stderr, " %.3f usec per snprintf of 12345\n",
timePer/100000);
/* hashtable lookup 100000 times */
@@ -5537,7 +5545,7 @@ TeststringbytesObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
- int n;
+ Tcl_Size n;
const unsigned char *p;
if (objc != 2) {
@@ -5673,7 +5681,7 @@ TestbytestringObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
- size_t n = 0;
+ Tcl_Size n = 0;
const char *p;
if (objc != 2) {
@@ -5922,7 +5930,7 @@ TestChannelCmd(
Tcl_Channel chan; /* The opaque type. */
size_t len; /* Length of subcommand string. */
int IOQueued; /* How much IO is queued inside channel? */
- char buf[TCL_INTEGER_SPACE];/* For sprintf. */
+ char buf[TCL_INTEGER_SPACE];/* For snprintf. */
int mode; /* rw mode of the channel */
if (argc < 2) {
@@ -5973,7 +5981,7 @@ TestChannelCmd(
if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerror", len) == 0)) {
- Tcl_Obj *msg = Tcl_NewStringObj(argv[3], TCL_INDEX_NONE);
+ Tcl_Obj *msg = Tcl_NewStringObj(argv[3], -1);
Tcl_IncrRefCount(msg);
Tcl_SetChannelError(chan, msg);
@@ -5986,7 +5994,7 @@ TestChannelCmd(
}
if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerrorinterp", len) == 0)) {
- Tcl_Obj *msg = Tcl_NewStringObj(argv[3], TCL_INDEX_NONE);
+ Tcl_Obj *msg = Tcl_NewStringObj(argv[3], -1);
Tcl_IncrRefCount(msg);
Tcl_SetChannelErrorInterp(interp, msg);
@@ -6373,7 +6381,7 @@ TestChannelCmd(
}
return TclChannelTransform(interp, chan,
- Tcl_NewStringObj(argv[4], TCL_INDEX_NONE));
+ Tcl_NewStringObj(argv[4], -1));
}
if ((cmdName[0] == 'u') && (strncmp(cmdName, "unstack", len) == 0)) {
@@ -6464,7 +6472,7 @@ TestChannelEventCmd(
esPtr->chanPtr = chanPtr;
esPtr->interp = interp;
esPtr->mask = mask;
- esPtr->scriptPtr = Tcl_NewStringObj(argv[4], TCL_INDEX_NONE);
+ esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
Tcl_IncrRefCount(esPtr->scriptPtr);
Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
@@ -6531,10 +6539,10 @@ TestChannelEventCmd(
esPtr = esPtr->nextPtr) {
if (esPtr->mask) {
Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
- (esPtr->mask == TCL_READABLE) ? "readable" : "writable", TCL_INDEX_NONE));
+ (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1));
} else {
Tcl_ListObjAppendElement(interp, resultListPtr,
- Tcl_NewStringObj("none", TCL_INDEX_NONE));
+ Tcl_NewStringObj("none", -1));
}
Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
}
@@ -6836,10 +6844,10 @@ TestGetIndexFromObjStructObjCmd(
return TCL_ERROR;
} else if (idx[1] != target) {
char buffer[64];
- sprintf(buffer, "%d", idx[1]);
+ snprintf(buffer, sizeof(buffer), "%d", idx[1]);
Tcl_AppendResult(interp, "index value comparison failed: got ",
buffer, NULL);
- sprintf(buffer, "%d", target);
+ snprintf(buffer, sizeof(buffer), "%d", target);
Tcl_AppendResult(interp, " when ", buffer, " expected", NULL);
return TCL_ERROR;
}
@@ -6889,7 +6897,7 @@ TestFilesystemObjCmd(
res = Tcl_FSUnregister(&testReportingFilesystem);
msg = (res == TCL_OK) ? "unregistered" : "failed";
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , TCL_INDEX_NONE));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1));
return res;
}
@@ -6971,7 +6979,7 @@ TestReport(
Tcl_DString ds;
Tcl_DStringInit(&ds);
- Tcl_DStringAppend(&ds, "lappend filesystemReport ", TCL_INDEX_NONE);
+ Tcl_DStringAppend(&ds, "lappend filesystemReport ", -1);
Tcl_DStringStartSublist(&ds);
Tcl_DStringAppendElement(&ds, cmd);
if (path != NULL) {
@@ -7260,7 +7268,7 @@ TestSimpleFilesystemObjCmd(
res = Tcl_FSUnregister(&simpleFilesystem);
msg = (res == TCL_OK) ? "unregistered" : "failed";
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , TCL_INDEX_NONE));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1));
return res;
}
@@ -7273,7 +7281,7 @@ static Tcl_Obj *
SimpleRedirect(
Tcl_Obj *pathPtr) /* Name of file to copy. */
{
- int len;
+ Tcl_Size len;
const char *str;
Tcl_Obj *origPtr;
@@ -7287,7 +7295,7 @@ SimpleRedirect(
Tcl_IncrRefCount(pathPtr);
return pathPtr;
}
- origPtr = Tcl_NewStringObj(str+10, TCL_INDEX_NONE);
+ origPtr = Tcl_NewStringObj(str+10, -1);
Tcl_IncrRefCount(origPtr);
return origPtr;
}
@@ -7319,7 +7327,7 @@ SimpleMatchInDirectory(
origPtr = SimpleRedirect(dirPtr);
res = Tcl_FSMatchInDirectory(interp, resPtr, origPtr, pattern, types);
if (res == TCL_OK) {
- size_t gLength, j;
+ Tcl_Size gLength, j;
Tcl_ListObjLength(NULL, resPtr, &gLength);
for (j = 0; j < gLength; j++) {
Tcl_Obj *gElt, *nElt;
@@ -7387,7 +7395,7 @@ SimpleListVolumes(void)
/* Add one new volume */
Tcl_Obj *retVal;
- retVal = Tcl_NewStringObj("simplefs:/", TCL_INDEX_NONE);
+ retVal = Tcl_NewStringObj("simplefs:/", -1);
Tcl_IncrRefCount(retVal);
return retVal;
}
@@ -7405,7 +7413,7 @@ TestUtfNextCmd(
int objc,
Tcl_Obj *const objv[])
{
- size_t numBytes;
+ Tcl_Size numBytes;
char *bytes;
const char *result, *first;
char buffer[32];
@@ -7418,7 +7426,7 @@ TestUtfNextCmd(
}
bytes = Tcl_GetStringFromObj(objv[1], &numBytes);
- if (numBytes + 4U > sizeof(buffer)) {
+ if (numBytes + 4 > (Tcl_Size) sizeof(buffer)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"testutfnext\" can only handle %" TCL_Z_MODIFIER "u bytes",
sizeof(buffer) - 4));
@@ -7541,7 +7549,7 @@ TestFindFirstCmd(
if (objc > 2) {
(void) Tcl_GetIntFromObj(interp, objv[2], &len);
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindFirst(Tcl_GetString(objv[1]), len), TCL_INDEX_NONE));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindFirst(Tcl_GetString(objv[1]), len), -1));
}
return TCL_OK;
}
@@ -7563,7 +7571,7 @@ TestFindLastCmd(
if (objc > 2) {
(void) Tcl_GetIntFromObj(interp, objv[2], &len);
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), TCL_INDEX_NONE));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1));
}
return TCL_OK;
}
@@ -7641,7 +7649,7 @@ TestcpuidCmd(
status = TclWinCPUID(index, regs);
if (status != TCL_OK) {
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("operation not available", TCL_INDEX_NONE));
+ Tcl_NewStringObj("operation not available", -1));
return status;
}
for (i=0 ; i<4 ; ++i) {
@@ -7687,7 +7695,7 @@ TestHashSystemHashCmd(
hPtr = Tcl_CreateHashEntry(&hash, INT2PTR(i), &isNew);
if (!isNew) {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
- Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem", TCL_INDEX_NONE);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem", -1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
@@ -7704,13 +7712,13 @@ TestHashSystemHashCmd(
hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i));
if (hPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
- Tcl_AppendToObj(Tcl_GetObjResult(interp)," lookup problem", TCL_INDEX_NONE);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp)," lookup problem", -1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
if (PTR2INT(Tcl_GetHashValue(hPtr)) != i+42) {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
- Tcl_AppendToObj(Tcl_GetObjResult(interp)," value problem", TCL_INDEX_NONE);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp)," value problem", -1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
@@ -7863,7 +7871,7 @@ TestNRELevels(
*
* This procedure implements the "testconcatobj" command. It is used
* to test that Tcl_ConcatObj does indeed return a fresh Tcl_Obj in all
- * cases and thet it never corrupts its arguments. In other words, that
+ * cases and that it never corrupts its arguments. In other words, that
* [Bug 1447328] was fixed properly.
*
* Results:
@@ -7884,7 +7892,7 @@ TestconcatobjCmd(
{
Tcl_Obj *list1Ptr, *list2Ptr, *emptyPtr, *concatPtr, *tmpPtr;
int result = TCL_OK;
- size_t len;
+ Tcl_Size len;
Tcl_Obj *objv[3];
/*
@@ -7893,15 +7901,15 @@ TestconcatobjCmd(
*/
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", TCL_INDEX_NONE));
+ Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", -1));
emptyPtr = Tcl_NewObj();
- list1Ptr = Tcl_NewStringObj("foo bar sum", TCL_INDEX_NONE);
+ list1Ptr = Tcl_NewStringObj("foo bar sum", -1);
Tcl_ListObjLength(NULL, list1Ptr, &len);
Tcl_InvalidateStringRep(list1Ptr);
- list2Ptr = Tcl_NewStringObj("eeny meeny", TCL_INDEX_NONE);
+ list2Ptr = Tcl_NewStringObj("eeny meeny", -1);
Tcl_ListObjLength(NULL, list2Ptr, &len);
Tcl_InvalidateStringRep(list2Ptr);
@@ -8241,7 +8249,7 @@ TestparseargsCmd(
Tcl_Obj *const objv[]) /* Arguments. */
{
static int foo = 0;
- size_t count = objc;
+ Tcl_Size count = objc;
Tcl_Obj **remObjv, *result[3];
Tcl_ArgvInfo argTable[] = {
{TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL},
@@ -8269,7 +8277,7 @@ InterpCmdResolver(
Tcl_Interp *interp,
const char *name,
TCL_UNUSED(Tcl_Namespace *),
- TCL_UNUSED(int) /*flags*/,
+ TCL_UNUSED(int) /* flags */,
Tcl_Command *rPtr)
{
Interp *iPtr = (Interp *) interp;
@@ -8454,7 +8462,7 @@ static int
InterpCompiledVarResolver(
TCL_UNUSED(Tcl_Interp *),
const char *name,
- TCL_UNUSED(Tcl_Size) /*length*/,
+ TCL_UNUSED(Tcl_Size) /* length */,
TCL_UNUSED(Tcl_Namespace *),
Tcl_ResolvedVarInfo **rPtr)
{
@@ -8464,7 +8472,7 @@ InterpCompiledVarResolver(
resVarInfo->vInfo.fetchProc = MyCompiledVarFetch;
resVarInfo->vInfo.deleteProc = MyCompiledVarFree;
resVarInfo->var = NULL;
- resVarInfo->nameObj = Tcl_NewStringObj(name, TCL_INDEX_NONE);
+ resVarInfo->nameObj = Tcl_NewStringObj(name, -1);
Tcl_IncrRefCount(resVarInfo->nameObj);
*rPtr = &resVarInfo->vInfo;
return TCL_OK;
@@ -8548,12 +8556,12 @@ int TestApplyLambdaObjCmd (
/* Create a lambda {{} {set a 42}} */
lambdaObjs[0] = Tcl_NewObj(); /* No parameters */
- lambdaObjs[1] = Tcl_NewStringObj("set a 42", TCL_INDEX_NONE); /* Body */
+ lambdaObjs[1] = Tcl_NewStringObj("set a 42", -1); /* Body */
lambdaObj = Tcl_NewListObj(2, lambdaObjs);
Tcl_IncrRefCount(lambdaObj);
/* Create the command "apply {{} {set a 42}" */
- evalObjs[0] = Tcl_NewStringObj("apply", TCL_INDEX_NONE);
+ evalObjs[0] = Tcl_NewStringObj("apply", -1);
Tcl_IncrRefCount(evalObjs[0]);
/*
* NOTE: IMPORTANT TO EXHIBIT THE BUG. We duplicate the lambda because
@@ -8594,6 +8602,102 @@ int TestApplyLambdaObjCmd (
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TestLutilCmd --
+ *
+ * This procedure implements the "testlequal" command. It is used to
+ * test compare two lists for equality using the string representation
+ * of each element. Implemented in C because script level loops are
+ * too slow for comparing large (GB count) lists.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestLutilCmd(
+ TCL_UNUSED(void *),
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Arguments. */
+{
+ Tcl_Size nL1, nL2;
+ Tcl_Obj *l1Obj = NULL;
+ Tcl_Obj *l2Obj = NULL;
+ Tcl_Obj **l1Elems;
+ Tcl_Obj **l2Elems;
+ static const char *const subcmds[] = {
+ "equal", "diffindex", NULL
+ };
+ enum options {
+ LUTIL_EQUAL, LUTIL_DIFFINDEX
+ } idx;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "list1 list2");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
+ &idx) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* Protect against shimmering, just to be safe */
+ l1Obj = Tcl_DuplicateObj(objv[2]);
+ l2Obj = Tcl_DuplicateObj(objv[3]);
+
+ int ret = TCL_ERROR;
+ if (Tcl_ListObjGetElements(interp, l1Obj, &nL1, &l1Elems) != TCL_OK) {
+ goto vamoose;
+ }
+ if (Tcl_ListObjGetElements(interp, l2Obj, &nL2, &l2Elems) != TCL_OK) {
+ goto vamoose;
+ }
+
+ Tcl_Size i, nCmp;
+
+ ret = TCL_OK;
+ switch (idx) {
+ case LUTIL_EQUAL:
+ /* Avoid the loop below if lengths differ */
+ if (nL1 != nL2) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ break;
+ }
+ /* FALLTHRU */
+ case LUTIL_DIFFINDEX:
+ nCmp = nL1 <= nL2 ? nL1 : nL2;
+ for (i = 0; i < nCmp; ++i) {
+ if (strcmp(Tcl_GetString(l1Elems[i]), Tcl_GetString(l2Elems[i]))) {
+ break;
+ }
+ }
+ if (i == nCmp && nCmp == nL1 && nCmp == nL2) {
+ nCmp = idx == LUTIL_EQUAL ? 1 : -1;
+ } else {
+ nCmp = idx == LUTIL_EQUAL ? 0 : i;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(nCmp));
+ break;
+ }
+
+vamoose:
+ if (l1Obj) {
+ Tcl_DecrRefCount(l1Obj);
+ }
+ if (l2Obj) {
+ Tcl_DecrRefCount(l2Obj);
+ }
+ return ret;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
generated by cgit v0.12 at 2025-12-24 19:16:58 (GMT)