summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c503
1 files changed, 413 insertions, 90 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 0ce5e83..d13b7ce 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -16,10 +16,13 @@
*/
#undef STATIC_BUILD
+#undef BUILD_tcl
#ifndef USE_TCL_STUBS
# define USE_TCL_STUBS
#endif
-#ifndef TCL_NO_DEPRECATED
+#ifdef TCL_NO_DEPRECATED
+# define TCL_UTF_MAX 4
+#else
# define TCL_NO_DEPRECATED
#endif
#include "tclInt.h"
@@ -58,6 +61,21 @@ static Tcl_DString delString;
static Tcl_Interp *delInterp;
/*
+ * One of the following structures exists for each command created by the
+ * "testcmdtoken" command.
+ */
+
+typedef struct TestCommandTokenRef {
+ int id; /* Identifier for this reference. */
+ Tcl_Command token; /* Tcl's token for the command. */
+ struct TestCommandTokenRef *nextPtr;
+ /* Next in list of references. */
+} TestCommandTokenRef;
+
+static TestCommandTokenRef *firstCommandTokenRef = NULL;
+static int nextCommandTokenRefId = 1;
+
+/*
* One of the following structures exists for each asynchronous handler
* created by the "testasync" command".
*/
@@ -219,6 +237,7 @@ static Tcl_ObjCmdProc TestbytestringObjCmd;
static Tcl_ObjCmdProc TestsetbytearraylengthObjCmd;
static Tcl_ObjCmdProc TestpurebytesobjObjCmd;
static Tcl_ObjCmdProc TeststringbytesObjCmd;
+static Tcl_ObjCmdProc Testutf16stringObjCmd;
static Tcl_CmdProc TestcmdinfoCmd;
static Tcl_CmdProc TestcmdtokenCmd;
static Tcl_CmdProc TestcmdtraceCmd;
@@ -254,6 +273,7 @@ static Tcl_ObjCmdProc TestgetvarfullnameCmd;
static Tcl_CmdProc TestinterpdeleteCmd;
static Tcl_CmdProc TestlinkCmd;
static Tcl_ObjCmdProc TestlinkarrayCmd;
+static Tcl_ObjCmdProc TestlistrepCmd;
static Tcl_ObjCmdProc TestlocaleCmd;
static Tcl_CmdProc TestmainthreadCmd;
static Tcl_CmdProc TestsetmainloopCmd;
@@ -338,6 +358,7 @@ static Tcl_ObjCmdProc TestInterpResolverCmd;
#if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL)
static Tcl_ObjCmdProc TestcpuidCmd;
#endif
+static Tcl_ObjCmdProc TestApplyLambdaObjCmd;
static const Tcl_Filesystem testReportingFilesystem = {
"reporting",
@@ -519,7 +540,8 @@ Tcltest_Init(
{
Tcl_CmdInfo info;
Tcl_Obj **objv, *objPtr;
- int objc, index;
+ size_t objc;
+ int index;
static const char *const specialOptions[] = {
"-appinitprocerror", "-appinitprocdeleteinterp",
"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
@@ -538,6 +560,12 @@ Tcltest_Init(
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
+#if TCL_MAJOR_VERSION > 8
+ if (info.isNativeObjectProc == 2) {
+ Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
+ info.objProc2, (void *)version, NULL);
+ } else
+#endif
Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
info.objProc, (void *)version, NULL);
}
@@ -556,6 +584,7 @@ Tcltest_Init(
Tcl_CreateObjCommand(interp, "testsetbytearraylength", TestsetbytearraylengthObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testutf16string", Testutf16stringObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
@@ -634,6 +663,7 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateCommand(interp, "testlink", TestlinkCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testlinkarray", TestlinkarrayCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testlistrep", TestlistrepCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL,
NULL);
Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL);
@@ -709,6 +739,8 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateObjCommand(interp, "testsetencpath", TestsetencpathObjCmd,
NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testapplylambda", TestApplyLambdaObjCmd,
+ NULL, NULL);
if (TclObjTest_Init(interp) != TCL_OK) {
return TCL_ERROR;
@@ -746,7 +778,7 @@ Tcltest_Init(
return TCL_ERROR;
}
case 3:
- if (objc-1) {
+ if (objc > 1) {
Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL, objv[1],
TCL_GLOBAL_ONLY);
}
@@ -791,6 +823,12 @@ Tcltest_SafeInit(
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
+#if TCL_MAJOR_VERSION > 8
+ if (info.isNativeObjectProc == 2) {
+ Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
+ info.objProc2, (void *)version, NULL);
+ } else
+#endif
Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
info.objProc, (void *)version, NULL);
}
@@ -901,7 +939,7 @@ TestasyncCmd(
break;
}
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], TCL_INDEX_NONE));
Tcl_MutexUnlock(&asyncTestMutex);
return code;
} else if (strcmp(argv[1], "marklater") == 0) {
@@ -969,7 +1007,7 @@ AsyncHandlerProc(
listArgv[3] = NULL;
cmd = Tcl_Merge(3, listArgv);
if (interp != NULL) {
- code = Tcl_EvalEx(interp, cmd, -1, 0);
+ code = Tcl_EvalEx(interp, cmd, TCL_INDEX_NONE, 0);
} else {
/*
* this should not happen, but by definition of how async handlers are
@@ -1150,8 +1188,8 @@ CmdDelProc1(
void *clientData) /* String to save. */
{
Tcl_DStringInit(&delString);
- Tcl_DStringAppend(&delString, "CmdDelProc1 ", -1);
- Tcl_DStringAppend(&delString, (char *) clientData, -1);
+ Tcl_DStringAppend(&delString, "CmdDelProc1 ", TCL_INDEX_NONE);
+ Tcl_DStringAppend(&delString, (char *) clientData, TCL_INDEX_NONE);
}
static void
@@ -1159,8 +1197,8 @@ CmdDelProc2(
void *clientData) /* String to save. */
{
Tcl_DStringInit(&delString);
- Tcl_DStringAppend(&delString, "CmdDelProc2 ", -1);
- Tcl_DStringAppend(&delString, (char *) clientData, -1);
+ Tcl_DStringAppend(&delString, "CmdDelProc2 ", TCL_INDEX_NONE);
+ Tcl_DStringAppend(&delString, (char *) clientData, TCL_INDEX_NONE);
}
/*
@@ -1187,9 +1225,9 @@ TestcmdtokenCmd(
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
- Tcl_Command token;
- int *l;
+ TestCommandTokenRef *refPtr;
char buf[30];
+ int id;
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -1197,24 +1235,42 @@ TestcmdtokenCmd(
return TCL_ERROR;
}
if (strcmp(argv[1], "create") == 0) {
- token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
+ refPtr = (TestCommandTokenRef *)Tcl_Alloc(sizeof(TestCommandTokenRef));
+ refPtr->token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
(void *) "original", NULL);
- sprintf(buf, "%p", (void *)token);
+ refPtr->id = nextCommandTokenRefId;
+ nextCommandTokenRefId++;
+ refPtr->nextPtr = firstCommandTokenRef;
+ firstCommandTokenRef = refPtr;
+ sprintf(buf, "%d", refPtr->id);
Tcl_AppendResult(interp, buf, NULL);
} else if (strcmp(argv[1], "name") == 0) {
Tcl_Obj *objPtr;
- if (sscanf(argv[2], "%p", &l) != 1) {
+ if (sscanf(argv[2], "%d", &id) != 1) {
+ Tcl_AppendResult(interp, "bad command token \"", argv[2],
+ "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ for (refPtr = firstCommandTokenRef; refPtr != NULL;
+ refPtr = refPtr->nextPtr) {
+ if (refPtr->id == id) {
+ break;
+ }
+ }
+
+ if (refPtr == NULL) {
Tcl_AppendResult(interp, "bad command token \"", argv[2],
"\"", NULL);
return TCL_ERROR;
}
objPtr = Tcl_NewObj();
- Tcl_GetCommandFullName(interp, (Tcl_Command) l, objPtr);
+ Tcl_GetCommandFullName(interp, refPtr->token, objPtr);
Tcl_AppendElement(interp,
- Tcl_GetCommandName(interp, (Tcl_Command) l));
+ Tcl_GetCommandName(interp, refPtr->token));
Tcl_AppendElement(interp, Tcl_GetString(objPtr));
Tcl_DecrRefCount(objPtr);
} else {
@@ -1262,7 +1318,7 @@ TestcmdtraceCmd(
if (strcmp(argv[1], "tracetest") == 0) {
Tcl_DStringInit(&buffer);
cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer);
- result = Tcl_EvalEx(interp, argv[2], -1, 0);
+ result = Tcl_EvalEx(interp, argv[2], TCL_INDEX_NONE, 0);
if (result == TCL_OK) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
@@ -1278,13 +1334,13 @@ TestcmdtraceCmd(
*/
cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceDeleteProc, NULL);
- Tcl_EvalEx(interp, argv[2], -1, 0);
+ Tcl_EvalEx(interp, argv[2], TCL_INDEX_NONE, 0);
} else if (strcmp(argv[1], "leveltest") == 0) {
Interp *iPtr = (Interp *) interp;
Tcl_DStringInit(&buffer);
cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4, CmdTraceProc,
&buffer);
- result = Tcl_EvalEx(interp, argv[2], -1, 0);
+ result = Tcl_EvalEx(interp, argv[2], TCL_INDEX_NONE, 0);
if (result == TCL_OK) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
@@ -1302,7 +1358,7 @@ TestcmdtraceCmd(
cmdTrace = Tcl_CreateObjTrace(interp, 50000,
TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc,
&deleteCalled, ObjTraceDeleteProc);
- result = Tcl_EvalEx(interp, argv[2], -1, 0);
+ result = Tcl_EvalEx(interp, argv[2], TCL_INDEX_NONE, 0);
Tcl_DeleteTrace(interp, cmdTrace);
if (!deleteCalled) {
Tcl_AppendResult(interp, "Delete wasn't called", NULL);
@@ -1316,7 +1372,7 @@ TestcmdtraceCmd(
Tcl_DStringInit(&buffer);
t1 = Tcl_CreateTrace(interp, 1, CmdTraceProc, &buffer);
t2 = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer);
- result = Tcl_EvalEx(interp, argv[2], -1, 0);
+ result = Tcl_EvalEx(interp, argv[2], TCL_INDEX_NONE, 0);
if (result == TCL_OK) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
@@ -1391,7 +1447,7 @@ ObjTraceProc(
const char *word = Tcl_GetString(objv[0]);
if (!strcmp(word, "Error")) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(command, TCL_INDEX_NONE));
return TCL_ERROR;
} else if (!strcmp(word, "Break")) {
return TCL_BREAK;
@@ -1640,7 +1696,7 @@ DelDeleteProc(
{
DelCmd *dPtr = (DelCmd *)clientData;
- Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, -1, 0);
+ Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, TCL_INDEX_NONE, 0);
Tcl_ResetResult(dPtr->interp);
ckfree(dPtr->deleteCmd);
ckfree(dPtr);
@@ -1755,7 +1811,7 @@ TestdoubledigitsObjCmd(
type = types[type];
if (objc > 4) {
if (strcmp(Tcl_GetString(objv[4]), "shorten")) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", TCL_INDEX_NONE));
return TCL_ERROR;
}
type |= TCL_DD_SHORTEST;
@@ -1999,7 +2055,7 @@ EncodingToUtfProc(
TclEncoding *encodingPtr;
encodingPtr = (TclEncoding *) clientData;
- Tcl_EvalEx(encodingPtr->interp, encodingPtr->toUtfCmd, -1, TCL_EVAL_GLOBAL);
+ Tcl_EvalEx(encodingPtr->interp, encodingPtr->toUtfCmd, TCL_INDEX_NONE, TCL_EVAL_GLOBAL);
len = strlen(Tcl_GetStringResult(encodingPtr->interp));
if (len > dstLen) {
@@ -2031,7 +2087,7 @@ EncodingFromUtfProc(
TclEncoding *encodingPtr;
encodingPtr = (TclEncoding *) clientData;
- Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd, -1, TCL_EVAL_GLOBAL);
+ Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd, TCL_INDEX_NONE, TCL_EVAL_GLOBAL);
len = strlen(Tcl_GetStringResult(encodingPtr->interp));
if (len > dstLen) {
@@ -2183,7 +2239,7 @@ TesteventObjCmd(
"head", "tail", "mark", NULL
};
int posIndex; /* Index of the chosen position */
- static const Tcl_QueuePosition posNum[] = {
+ static const int posNum[] = {
/* Interpretation of the chosen position */
TCL_QUEUE_HEAD,
TCL_QUEUE_TAIL,
@@ -3070,7 +3126,7 @@ TestlinkCmd(
}
}
if (argv[6][0] != 0) {
- tmp = Tcl_NewStringObj(argv[6], -1);
+ tmp = Tcl_NewStringObj(argv[6], TCL_INDEX_NONE);
if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
Tcl_DecrRefCount(tmp);
return TCL_ERROR;
@@ -3128,7 +3184,7 @@ TestlinkCmd(
}
if (argv[15][0]) {
Tcl_WideInt w;
- tmp = Tcl_NewStringObj(argv[15], -1);
+ tmp = Tcl_NewStringObj(argv[15], TCL_INDEX_NONE);
if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) {
Tcl_DecrRefCount(tmp);
return TCL_ERROR;
@@ -3178,7 +3234,7 @@ TestlinkCmd(
Tcl_UpdateLinkedVar(interp, "string");
}
if (argv[6][0] != 0) {
- tmp = Tcl_NewStringObj(argv[6], -1);
+ tmp = Tcl_NewStringObj(argv[6], TCL_INDEX_NONE);
if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
Tcl_DecrRefCount(tmp);
return TCL_ERROR;
@@ -3245,7 +3301,7 @@ TestlinkCmd(
}
if (argv[15][0]) {
Tcl_WideInt w;
- tmp = Tcl_NewStringObj(argv[15], -1);
+ tmp = Tcl_NewStringObj(argv[15], TCL_INDEX_NONE);
if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) {
Tcl_DecrRefCount(tmp);
return TCL_ERROR;
@@ -3352,7 +3408,7 @@ TestlinkarrayCmd(
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, objv[i++], &size) == TCL_ERROR) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong size value", -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong size value", TCL_INDEX_NONE));
return TCL_ERROR;
}
name = Tcl_GetString(objv[i++]);
@@ -3364,7 +3420,7 @@ TestlinkarrayCmd(
if (i < objc) {
if (Tcl_GetWideIntFromObj(interp, objv[i], &addr) == TCL_ERROR) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "wrong address value", -1));
+ "wrong address value", TCL_INDEX_NONE));
return TCL_ERROR;
}
} else {
@@ -3383,6 +3439,158 @@ TestlinkarrayCmd(
/*
*----------------------------------------------------------------------
*
+ * TestlistrepCmd --
+ *
+ * This function is invoked to generate a list object with a specific
+ * internal representation.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestlistrepCmd(
+ TCL_UNUSED(void *),
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ /* Subcommands supported by this command */
+ const char* subcommands[] = {
+ "new",
+ "describe",
+ "config",
+ "validate",
+ NULL
+ };
+ enum {
+ LISTREP_NEW,
+ LISTREP_DESCRIBE,
+ LISTREP_CONFIG,
+ LISTREP_VALIDATE
+ } cmdIndex;
+ Tcl_Obj *resultObj = NULL;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(
+ interp, objv[1], subcommands, "command", 0, &cmdIndex)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (cmdIndex) {
+ case LISTREP_NEW:
+ if (objc < 3 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "length ?leadSpace endSpace?");
+ return TCL_ERROR;
+ } else {
+ int length;
+ int leadSpace = 0;
+ int endSpace = 0;
+ if (Tcl_GetIntFromObj(interp, objv[2], &length) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc > 3) {
+ if (Tcl_GetIntFromObj(interp, objv[3], &leadSpace) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc > 4) {
+ if (Tcl_GetIntFromObj(interp, objv[4], &endSpace)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ }
+ resultObj = TclListTestObj(length, leadSpace, endSpace);
+ }
+ break;
+
+ case LISTREP_DESCRIBE:
+#define APPEND_FIELD(targetObj_, structPtr_, fld_) \
+ do { \
+ Tcl_ListObjAppendElement( \
+ interp, (targetObj_), Tcl_NewStringObj(#fld_, TCL_INDEX_NONE)); \
+ Tcl_ListObjAppendElement( \
+ interp, (targetObj_), Tcl_NewWideIntObj((structPtr_)->fld_)); \
+ } while (0)
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "object");
+ return TCL_ERROR;
+ } else {
+ Tcl_Obj **objs;
+ ListSizeT nobjs;
+ ListRep listRep;
+ Tcl_Obj *listRepObjs[4];
+
+ /* Force list representation */
+ if (Tcl_ListObjGetElements(interp, objv[2], &nobjs, &objs) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ListObjGetRep(objv[2], &listRep);
+ listRepObjs[0] = Tcl_NewStringObj("store", TCL_INDEX_NONE);
+ listRepObjs[1] = Tcl_NewListObj(12, NULL);
+ Tcl_ListObjAppendElement(
+ interp, listRepObjs[1], Tcl_NewStringObj("memoryAddress", TCL_INDEX_NONE));
+ Tcl_ListObjAppendElement(
+ interp, listRepObjs[1], Tcl_ObjPrintf("%p", listRep.storePtr));
+ APPEND_FIELD(listRepObjs[1], listRep.storePtr, firstUsed);
+ APPEND_FIELD(listRepObjs[1], listRep.storePtr, numUsed);
+ APPEND_FIELD(listRepObjs[1], listRep.storePtr, numAllocated);
+ 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[3] = Tcl_NewListObj(8, NULL);
+ Tcl_ListObjAppendElement(interp,
+ listRepObjs[3],
+ Tcl_NewStringObj("memoryAddress", TCL_INDEX_NONE));
+ Tcl_ListObjAppendElement(
+ interp, listRepObjs[3], Tcl_ObjPrintf("%p", listRep.spanPtr));
+ APPEND_FIELD(listRepObjs[3], listRep.spanPtr, spanStart);
+ APPEND_FIELD(
+ listRepObjs[3], listRep.spanPtr, spanLength);
+ APPEND_FIELD(listRepObjs[3], listRep.spanPtr, refCount);
+ }
+ resultObj = Tcl_NewListObj(listRep.spanPtr ? 4 : 2, listRepObjs);
+ }
+#undef APPEND_FIELD
+ break;
+
+ case LISTREP_CONFIG:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "object");
+ return TCL_ERROR;
+ }
+ resultObj = Tcl_NewListObj(2, NULL);
+ Tcl_ListObjAppendElement(
+ NULL, resultObj, Tcl_NewStringObj("LIST_SPAN_THRESHOLD", TCL_INDEX_NONE));
+ Tcl_ListObjAppendElement(
+ NULL, resultObj, Tcl_NewWideIntObj(LIST_SPAN_THRESHOLD));
+ break;
+
+ case LISTREP_VALIDATE:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "object");
+ return TCL_ERROR;
+ }
+ TclListObjValidate(interp, objv[2]); /* Panics if invalid */
+ resultObj = Tcl_NewObj();
+ break;
+ }
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestlocaleCmd --
*
* This procedure implements the "testlocale" command. It is used
@@ -3436,7 +3644,7 @@ TestlocaleCmd(
}
locale = setlocale(lcTypes[index], locale);
if (locale) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, -1);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, TCL_INDEX_NONE);
}
return TCL_OK;
}
@@ -3658,7 +3866,7 @@ PrintParse(
break;
}
Tcl_ListObjAppendElement(NULL, objPtr,
- Tcl_NewStringObj(typeString, -1));
+ Tcl_NewStringObj(typeString, TCL_INDEX_NONE));
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(tokenPtr->start, tokenPtr->size));
Tcl_ListObjAppendElement(NULL, objPtr,
@@ -3667,7 +3875,7 @@ PrintParse(
Tcl_ListObjAppendElement(NULL, objPtr,
parsePtr->commandStart ?
Tcl_NewStringObj(parsePtr->commandStart + parsePtr->commandSize,
- -1) : Tcl_NewObj());
+ TCL_INDEX_NONE) : Tcl_NewObj());
}
/*
@@ -3986,7 +4194,7 @@ TestregexpObjCmd(
char resinfo[TCL_INTEGER_SPACE * 2];
varName = Tcl_GetString(objv[2]);
- TclRegExpRangeUniChar(regExpr, -1, &start, &end);
+ TclRegExpRangeUniChar(regExpr, TCL_INDEX_NONE, &start, &end);
sprintf(resinfo, "%d %d", start, end-1);
value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
if (value == NULL) {
@@ -4026,15 +4234,15 @@ TestregexpObjCmd(
Tcl_Obj *newPtr, *varPtr, *valuePtr;
varPtr = objv[i];
- ii = ((cflags&REG_EXPECT) && i == objc-1) ? -1 : i;
+ ii = ((cflags&REG_EXPECT) && i == objc-1) ? TCL_INDEX_NONE : i;
if (indices) {
Tcl_Obj *objs[2];
- if (ii == -1) {
+ if (ii == TCL_INDEX_NONE) {
TclRegExpRangeUniChar(regExpr, ii, &start, &end);
} else if (ii > info.nsubs) {
- start = -1;
- end = -1;
+ start = TCL_INDEX_NONE;
+ end = TCL_INDEX_NONE;
} else {
start = info.matches[ii].start;
end = info.matches[ii].end;
@@ -4054,7 +4262,7 @@ TestregexpObjCmd(
newPtr = Tcl_NewListObj(2, objs);
} else {
- if (ii == -1) {
+ if (ii == TCL_INDEX_NONE) {
TclRegExpRangeUniChar(regExpr, ii, &start, &end);
newPtr = Tcl_GetRange(objPtr, start, end);
} else if (ii > info.nsubs || info.matches[ii].end <= 0) {
@@ -4102,7 +4310,8 @@ TestregexpXflags(
int *cflagsPtr, /* compile flags word */
int *eflagsPtr) /* exec flags word */
{
- int i, cflags, eflags;
+ int i;
+ int cflags, eflags;
cflags = *cflagsPtr;
eflags = *eflagsPtr;
@@ -4307,7 +4516,7 @@ TestsetplatformCmd(
* A standard Tcl result.
*
* Side effects:
- * When the packge given by argv[1] is loaded into an interpeter,
+ * When the packge given by argv[1] is loaded into an interpreter,
* variable "x" in that interpreter is set to "loaded".
*
*----------------------------------------------------------------------
@@ -4560,7 +4769,7 @@ TestfeventCmd(
return TCL_ERROR;
}
if (interp2 != NULL) {
- code = Tcl_EvalEx(interp2, argv[2], -1, TCL_EVAL_GLOBAL);
+ code = Tcl_EvalEx(interp2, argv[2], TCL_INDEX_NONE, TCL_EVAL_GLOBAL);
Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2));
return code;
} else {
@@ -4854,15 +5063,15 @@ GetTimesObjCmd(
ckfree(objv);
/* TclGetString 100000 times */
- fprintf(stderr, "TclGetStringFromObj of \"12345\" 100000 times\n");
- objPtr = Tcl_NewStringObj("12345", -1);
+ fprintf(stderr, "Tcl_GetStringFromObj of \"12345\" 100000 times\n");
+ objPtr = Tcl_NewStringObj("12345", TCL_INDEX_NONE);
Tcl_GetTime(&start);
for (i = 0; i < 100000; i++) {
(void) TclGetString(objPtr);
}
Tcl_GetTime(&stop);
timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
- fprintf(stderr, " %.3f usec per TclGetStringFromObj of \"12345\"\n",
+ fprintf(stderr, " %.3f usec per Tcl_GetStringFromObj of \"12345\"\n",
timePer/100000);
/* Tcl_GetIntFromObj 100000 times */
@@ -5172,6 +5381,43 @@ TestbytestringObjCmd(
/*
*----------------------------------------------------------------------
*
+ * Testutf16stringObjCmd --
+ *
+ * This specifically tests the Tcl_GetUnicode and Tcl_NewUnicodeObj
+ * C functions which broke in Tcl 8.7 and were undetected by the
+ * existing test suite. Bug [b79df322a9]
+ *
+ * Results:
+ * Returns the TCL_OK result code.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Testutf16stringObjCmd(
+ TCL_UNUSED(void *),
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
+{
+ const unsigned short *p;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string");
+ return TCL_ERROR;
+ }
+
+ p = Tcl_GetUnicode(objv[1]);
+ Tcl_SetObjResult(interp, Tcl_NewUnicodeObj(p, TCL_INDEX_NONE));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestsetCmd --
*
* Implements the "testset{err,noerr}" cmds that are used when testing
@@ -5303,7 +5549,7 @@ TestsaveresultCmd(
}
freeCount = 0;
- objPtr = NULL; /* Lint. */
+ objPtr = NULL;
switch ((enum options) index) {
case RESULT_SMALL:
Tcl_AppendResult(interp, "small result", NULL);
@@ -5322,7 +5568,7 @@ TestsaveresultCmd(
Tcl_SetResult(interp, (char *)"dynamic result", TestsaveresultFree);
break;
case RESULT_OBJECT:
- objPtr = Tcl_NewStringObj("object result", -1);
+ objPtr = Tcl_NewStringObj("object result", TCL_INDEX_NONE);
Tcl_SetObjResult(interp, objPtr);
break;
}
@@ -5332,7 +5578,7 @@ TestsaveresultCmd(
if (((enum options) index) == RESULT_OBJECT) {
result = Tcl_EvalObjEx(interp, objv[2], 0);
} else {
- result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), -1, 0);
+ result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), TCL_INDEX_NONE, 0);
}
if (discard) {
@@ -5584,7 +5830,7 @@ TestChannelCmd(
if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerror", len) == 0)) {
- Tcl_Obj *msg = Tcl_NewStringObj(argv[3],-1);
+ Tcl_Obj *msg = Tcl_NewStringObj(argv[3], TCL_INDEX_NONE);
Tcl_IncrRefCount(msg);
Tcl_SetChannelError(chan, msg);
@@ -5597,7 +5843,7 @@ TestChannelCmd(
}
if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerrorinterp", len) == 0)) {
- Tcl_Obj *msg = Tcl_NewStringObj(argv[3],-1);
+ Tcl_Obj *msg = Tcl_NewStringObj(argv[3], TCL_INDEX_NONE);
Tcl_IncrRefCount(msg);
Tcl_SetChannelErrorInterp(interp, msg);
@@ -5945,7 +6191,7 @@ TestChannelCmd(
}
return TclChannelTransform(interp, chan,
- Tcl_NewStringObj(argv[4], -1));
+ Tcl_NewStringObj(argv[4], TCL_INDEX_NONE));
}
if ((cmdName[0] == 'u') && (strncmp(cmdName, "unstack", len) == 0)) {
@@ -6036,7 +6282,7 @@ TestChannelEventCmd(
esPtr->chanPtr = chanPtr;
esPtr->interp = interp;
esPtr->mask = mask;
- esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
+ esPtr->scriptPtr = Tcl_NewStringObj(argv[4], TCL_INDEX_NONE);
Tcl_IncrRefCount(esPtr->scriptPtr);
Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
@@ -6103,10 +6349,10 @@ TestChannelEventCmd(
esPtr = esPtr->nextPtr) {
if (esPtr->mask) {
Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
- (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1));
+ (esPtr->mask == TCL_READABLE) ? "readable" : "writable", TCL_INDEX_NONE));
} else {
Tcl_ListObjAppendElement(interp, resultListPtr,
- Tcl_NewStringObj("none", -1));
+ Tcl_NewStringObj("none", TCL_INDEX_NONE));
}
Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
}
@@ -6318,16 +6564,12 @@ TestWrongNumArgsObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int i, length;
+ int i;
+ int length;
const char *msg;
if (objc < 3) {
- /*
- * Don't use Tcl_WrongNumArgs here, as that is the function
- * we want to test!
- */
- Tcl_AppendResult(interp, "insufficient arguments", NULL);
- return TCL_ERROR;
+ goto insufArgs;
}
if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) {
@@ -6343,6 +6585,7 @@ TestWrongNumArgsObjCmd(
/*
* Asked for more arguments than were given.
*/
+ insufArgs:
Tcl_AppendResult(interp, "insufficient arguments", NULL);
return TCL_ERROR;
}
@@ -6453,7 +6696,7 @@ TestFilesystemObjCmd(
res = Tcl_FSUnregister(&testReportingFilesystem);
msg = (res == TCL_OK) ? "unregistered" : "failed";
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , TCL_INDEX_NONE));
return res;
}
@@ -6535,7 +6778,7 @@ TestReport(
Tcl_DString ds;
Tcl_DStringInit(&ds);
- Tcl_DStringAppend(&ds, "lappend filesystemReport ", -1);
+ Tcl_DStringAppend(&ds, "lappend filesystemReport ", TCL_INDEX_NONE);
Tcl_DStringStartSublist(&ds);
Tcl_DStringAppendElement(&ds, cmd);
if (path != NULL) {
@@ -6548,7 +6791,7 @@ TestReport(
savedResult = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(savedResult);
Tcl_SetObjResult(interp, Tcl_NewObj());
- Tcl_EvalEx(interp, Tcl_DStringValue(&ds), -1, 0);
+ Tcl_EvalEx(interp, Tcl_DStringValue(&ds), TCL_INDEX_NONE, 0);
Tcl_DStringFree(&ds);
Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, savedResult);
@@ -6824,7 +7067,7 @@ TestSimpleFilesystemObjCmd(
res = Tcl_FSUnregister(&simpleFilesystem);
msg = (res == TCL_OK) ? "unregistered" : "failed";
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , TCL_INDEX_NONE));
return res;
}
@@ -6851,7 +7094,7 @@ SimpleRedirect(
Tcl_IncrRefCount(pathPtr);
return pathPtr;
}
- origPtr = Tcl_NewStringObj(str+10,-1);
+ origPtr = Tcl_NewStringObj(str+10, TCL_INDEX_NONE);
Tcl_IncrRefCount(origPtr);
return origPtr;
}
@@ -6883,7 +7126,7 @@ SimpleMatchInDirectory(
origPtr = SimpleRedirect(dirPtr);
res = Tcl_FSMatchInDirectory(interp, resPtr, origPtr, pattern, types);
if (res == TCL_OK) {
- int gLength, j;
+ size_t gLength, j;
Tcl_ListObjLength(NULL, resPtr, &gLength);
for (j = 0; j < gLength; j++) {
Tcl_Obj *gElt, *nElt;
@@ -6951,7 +7194,7 @@ SimpleListVolumes(void)
/* Add one new volume */
Tcl_Obj *retVal;
- retVal = Tcl_NewStringObj("simplefs:/", -1);
+ retVal = Tcl_NewStringObj("simplefs:/", TCL_INDEX_NONE);
Tcl_IncrRefCount(retVal);
return retVal;
}
@@ -6969,7 +7212,7 @@ TestUtfNextCmd(
int objc,
Tcl_Obj *const objv[])
{
- size_t numBytes;
+ int numBytes;
char *bytes;
const char *result, *first;
char buffer[32];
@@ -6982,7 +7225,7 @@ TestUtfNextCmd(
}
bytes = Tcl_GetStringFromObj(objv[1], &numBytes);
- if (numBytes + 4 > sizeof(buffer)) {
+ if (numBytes + 4U > sizeof(buffer)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"testutfnext\" can only handle %" TCL_Z_MODIFIER "u bytes",
sizeof(buffer) - 4));
@@ -7071,7 +7314,7 @@ TestNumUtfCharsCmd(
Tcl_Obj *const objv[])
{
if (objc > 1) {
- int numBytes, len, limit = -1;
+ int numBytes, len, limit = TCL_INDEX_NONE;
const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes);
if (objc > 2) {
@@ -7105,7 +7348,7 @@ TestFindFirstCmd(
if (objc > 2) {
(void) Tcl_GetIntFromObj(interp, objv[2], &len);
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindFirst(Tcl_GetString(objv[1]), len), -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindFirst(Tcl_GetString(objv[1]), len), TCL_INDEX_NONE));
}
return TCL_OK;
}
@@ -7127,7 +7370,7 @@ TestFindLastCmd(
if (objc > 2) {
(void) Tcl_GetIntFromObj(interp, objv[2], &len);
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), TCL_INDEX_NONE));
}
return TCL_OK;
}
@@ -7204,7 +7447,7 @@ TestcpuidCmd(
status = TclWinCPUID(index, regs);
if (status != TCL_OK) {
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("operation not available", -1));
+ Tcl_NewStringObj("operation not available", TCL_INDEX_NONE));
return status;
}
for (i=0 ; i<4 ; ++i) {
@@ -7250,7 +7493,7 @@ TestHashSystemHashCmd(
hPtr = Tcl_CreateHashEntry(&hash, INT2PTR(i), &isNew);
if (!isNew) {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
- Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem", TCL_INDEX_NONE);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
@@ -7267,13 +7510,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",-1);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp)," lookup problem", TCL_INDEX_NONE);
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",-1);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp)," value problem", TCL_INDEX_NONE);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
@@ -7356,9 +7599,9 @@ NREUnwind_callback(
&none, NULL);
} else {
Tcl_Obj *idata[3];
- idata[0] = Tcl_NewWideIntObj((int) ((char *) data[1] - (char *) data[0]));
- idata[1] = Tcl_NewWideIntObj((int) ((char *) data[2] - (char *) data[0]));
- idata[2] = Tcl_NewWideIntObj((int) ((char *) &none - (char *) data[0]));
+ idata[0] = Tcl_NewWideIntObj(((char *) data[1] - (char *) data[0]));
+ idata[1] = Tcl_NewWideIntObj(((char *) data[2] - (char *) data[0]));
+ idata[2] = Tcl_NewWideIntObj(((char *) &none - (char *) data[0]));
Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata));
}
return TCL_OK;
@@ -7446,7 +7689,8 @@ TestconcatobjCmd(
TCL_UNUSED(const char **) /*argv*/)
{
Tcl_Obj *list1Ptr, *list2Ptr, *emptyPtr, *concatPtr, *tmpPtr;
- int result = TCL_OK, len;
+ int result = TCL_OK;
+ size_t len;
Tcl_Obj *objv[3];
/*
@@ -7455,15 +7699,15 @@ TestconcatobjCmd(
*/
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", -1));
+ Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", TCL_INDEX_NONE));
emptyPtr = Tcl_NewObj();
- list1Ptr = Tcl_NewStringObj("foo bar sum", -1);
+ list1Ptr = Tcl_NewStringObj("foo bar sum", TCL_INDEX_NONE);
Tcl_ListObjLength(NULL, list1Ptr, &len);
Tcl_InvalidateStringRep(list1Ptr);
- list2Ptr = Tcl_NewStringObj("eeny meeny", -1);
+ list2Ptr = Tcl_NewStringObj("eeny meeny", TCL_INDEX_NONE);
Tcl_ListObjLength(NULL, list2Ptr, &len);
Tcl_InvalidateStringRep(list2Ptr);
@@ -7803,7 +8047,7 @@ TestparseargsCmd(
Tcl_Obj *const objv[]) /* Arguments. */
{
static int foo = 0;
- int count = objc;
+ size_t count = objc;
Tcl_Obj **remObjv, *result[3];
Tcl_ArgvInfo argTable[] = {
{TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL},
@@ -8026,7 +8270,7 @@ InterpCompiledVarResolver(
resVarInfo->vInfo.fetchProc = MyCompiledVarFetch;
resVarInfo->vInfo.deleteProc = MyCompiledVarFree;
resVarInfo->var = NULL;
- resVarInfo->nameObj = Tcl_NewStringObj(name, -1);
+ resVarInfo->nameObj = Tcl_NewStringObj(name, TCL_INDEX_NONE);
Tcl_IncrRefCount(resVarInfo->nameObj);
*rPtr = &resVarInfo->vInfo;
return TCL_OK;
@@ -8076,7 +8320,85 @@ TestInterpResolverCmd(
}
return TCL_OK;
}
-
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * TestApplyLambdaObjCmd --
+ *
+ * Implements the Tcl command testapplylambda. This tests the apply
+ * implementation handling of a lambda where the lambda has a list
+ * internal representation where the second element's internal
+ * representation is already a byte code object.
+ *
+ * Results:
+ * TCL_OK - Success. Caller should check result is 42
+ * TCL_ERROR - Error.
+ *
+ * Side effects:
+ * In the presence of the apply bug, may panic. Otherwise
+ * Interpreter result holds result or error message.
+ *
+ *------------------------------------------------------------------------
+ */
+int TestApplyLambdaObjCmd (
+ TCL_UNUSED(void*),
+ Tcl_Interp *interp, /* Current interpreter. */
+ TCL_UNUSED(int), /* objc. */
+ TCL_UNUSED(Tcl_Obj *const *)) /* objv. */
+{
+ Tcl_Obj *lambdaObjs[2];
+ Tcl_Obj *evalObjs[2];
+ Tcl_Obj *lambdaObj;
+ int result;
+
+ /* Create a lambda {{} {set a 42}} */
+ lambdaObjs[0] = Tcl_NewObj(); /* No parameters */
+ lambdaObjs[1] = Tcl_NewStringObj("set a 42", TCL_INDEX_NONE); /* Body */
+ lambdaObj = Tcl_NewListObj(2, lambdaObjs);
+ Tcl_IncrRefCount(lambdaObj);
+
+ /* Create the command "apply {{} {set a 42}" */
+ evalObjs[0] = Tcl_NewStringObj("apply", TCL_INDEX_NONE);
+ Tcl_IncrRefCount(evalObjs[0]);
+ /*
+ * NOTE: IMPORTANT TO EXHIBIT THE BUG. We duplicate the lambda because
+ * it will get shimmered to a Lambda internal representation but we
+ * want to hold on to our list representation.
+ */
+ evalObjs[1] = Tcl_DuplicateObj(lambdaObj);
+ Tcl_IncrRefCount(evalObjs[1]);
+
+ /* Evaluate it */
+ result = Tcl_EvalObjv(interp, 2, evalObjs, TCL_EVAL_GLOBAL);
+ if (result != TCL_OK) {
+ Tcl_DecrRefCount(evalObjs[0]);
+ Tcl_DecrRefCount(evalObjs[1]);
+ return result;
+ }
+ /*
+ * So far so good. At this point,
+ * - evalObjs[1] has an internal representation of Lambda
+ * - lambdaObj[1] ({set a 42}) has been shimmered to
+ * an internal representation of ByteCode.
+ */
+ Tcl_DecrRefCount(evalObjs[1]); /* Don't need this anymore */
+ /*
+ * The bug trigger. Repeating the command but:
+ * - we are calling apply with a lambda that is a list (as BEFORE),
+ * BUT
+ * - The body of the lambda (lambdaObjs[1]) ALREADY has internal
+ * representation of ByteCode and thus will not be compiled again
+ */
+ evalObjs[1] = lambdaObj; /* lambdaObj already has a ref count so
+ no need for IncrRef */
+ result = Tcl_EvalObjv(interp, 2, evalObjs, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(evalObjs[0]);
+ Tcl_DecrRefCount(lambdaObj);
+
+ return result;
+}
+
/*
* Local Variables:
* mode: c
@@ -8086,3 +8408,4 @@ TestInterpResolverCmd(
* indent-tabs-mode: nil
* End:
*/
+
generated by cgit v0.12 at 2025-12-15 10:40:03 (GMT)