summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclTest.c43
-rw-r--r--generic/tclTestObj.c2
-rw-r--r--generic/tclTestProcBodyObj.c6
-rw-r--r--generic/tclThreadTest.c8
4 files changed, 37 insertions, 22 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 6ab1979..ef9997a 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -1020,7 +1020,7 @@ AsyncHandlerProc(
TclFormatInt(string, code);
listArgv[0] = asyncPtr->command;
- listArgv[1] = Tcl_GetString(Tcl_GetObjResult(interp));
+ listArgv[1] = Tcl_GetStringResult(interp);
listArgv[2] = string;
listArgv[3] = NULL;
cmd = Tcl_Merge(3, listArgv);
@@ -1116,20 +1116,33 @@ TestcmdinfoObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
+ static const char *const subcmds[] = {
+ "create", "delete", "get", "modify", NULL
+ };
+ enum options {
+ CMDINFO_CREATE, CMDINFO_DELETE, CMDINFO_GET, CMDINFO_MODIFY
+ } idx;
Tcl_CmdInfo info;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "command arg");
return TCL_ERROR;
}
- if (strcmp(Tcl_GetString(objv[1]), "create") == 0) {
- Tcl_CreateCommand(interp, Tcl_GetString(objv[2]), CmdProc1, (void *) "original",
- CmdDelProc1);
- } else if (strcmp(Tcl_GetString(objv[1]), "delete") == 0) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
+ &idx) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (idx) {
+ case CMDINFO_CREATE:
+ Tcl_CreateCommand(interp, Tcl_GetString(objv[2]), CmdProc1,
+ (void *)"original", CmdDelProc1);
+ break;
+ case CMDINFO_DELETE:
Tcl_DStringInit(&delString);
Tcl_DeleteCommand(interp, Tcl_GetString(objv[2]));
Tcl_DStringResult(interp, &delString);
- } else if (strcmp(Tcl_GetString(objv[1]), "get") == 0) {
+ break;
+ case CMDINFO_GET:
if (Tcl_GetCommandInfo(interp, Tcl_GetString(objv[2]), &info) ==0) {
Tcl_AppendResult(interp, "??", NULL);
return TCL_OK;
@@ -1153,12 +1166,17 @@ TestcmdinfoObjCmd(
Tcl_AppendResult(interp, " unknown", NULL);
}
Tcl_AppendResult(interp, " ", info.namespacePtr->fullName, NULL);
- if (info.isNativeObjectProc) {
+ if (info.isNativeObjectProc == 0) {
+ Tcl_AppendResult(interp, " stringProc", NULL);
+ } else if (info.isNativeObjectProc == 1) {
Tcl_AppendResult(interp, " nativeObjectProc", NULL);
} else {
- Tcl_AppendResult(interp, " stringProc", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("Invalid isNativeObjectProc value %d",
+ info.isNativeObjectProc));
+ return TCL_ERROR;
}
- } else if (strcmp(Tcl_GetString(objv[1]), "modify") == 0) {
+ break;
+ case CMDINFO_MODIFY:
info.proc = CmdProc2;
info.clientData = (void *) "new_command_data";
info.objProc = NULL;
@@ -1170,10 +1188,7 @@ TestcmdinfoObjCmd(
} else {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
}
- } else {
- Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
- "\": must be create, delete, get, or modify", NULL);
- return TCL_ERROR;
+ break;
}
return TCL_OK;
@@ -7627,7 +7642,7 @@ TestUtfNextCmd(
}
bytes = Tcl_GetStringFromObj(objv[1], &numBytes);
- if (numBytes + 4U > sizeof(buffer)) {
+ if ((size_t)numBytes > sizeof(buffer) - 4) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"testutfnext\" can only handle %" TCL_Z_MODIFIER "u bytes",
sizeof(buffer) - 4));
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 7aeb329..3b21eaf 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -1631,7 +1631,7 @@ CheckIfVarUnset(
Tcl_Obj ** varPtr,
Tcl_Size varIndex) /* Index of the test variable to check. */
{
- if (varPtr[varIndex] == NULL) {
+ if (varIndex < 0 || varPtr[varIndex] == NULL) {
char buf[32 + TCL_INTEGER_SPACE];
snprintf(buf, sizeof(buf), "variable %" TCL_SIZE_MODIFIER "d is unset (NULL)", varIndex);
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c
index b6dbc3f..07800ca 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.c
@@ -35,7 +35,7 @@ static const char checkCommand[] = "check";
* procs
*/
-typedef struct CmdTable {
+typedef struct {
const char *cmdName; /* command name */
Tcl_ObjCmdProc *proc; /* command proc */
int exportIt; /* if 1, export the command */
@@ -188,7 +188,7 @@ ProcBodyTestInitInternal(
}
}
- return Tcl_PkgProvide(interp, packageName, packageVersion);
+ return Tcl_PkgProvideEx(interp, packageName, packageVersion, NULL);
}
/*
@@ -337,7 +337,7 @@ ProcBodyTestCheckObjCmd(
return TCL_ERROR;
}
- version = Tcl_PkgPresent(interp, packageName, packageVersion, 1);
+ version = Tcl_PkgPresentEx(interp, packageName, packageVersion, 1, NULL);
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
strcmp(version, packageVersion) == 0));
return TCL_OK;
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 44d2b0e..99f9838 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -656,10 +656,10 @@ ThreadErrorProc(
errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
if (errorProcString == NULL) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
- Tcl_WriteChars(errChannel, "Error from thread ", TCL_INDEX_NONE);
- Tcl_WriteChars(errChannel, buf, TCL_INDEX_NONE);
+ Tcl_WriteChars(errChannel, "Error from thread ", -1);
+ Tcl_WriteChars(errChannel, buf, -1);
Tcl_WriteChars(errChannel, "\n", 1);
- Tcl_WriteChars(errChannel, errorInfo, TCL_INDEX_NONE);
+ Tcl_WriteChars(errChannel, errorInfo, -1);
Tcl_WriteChars(errChannel, "\n", 1);
} else {
argv[0] = errorProcString;
@@ -984,7 +984,7 @@ ThreadCancel(
Tcl_MutexUnlock(&threadMutex);
Tcl_ResetResult(interp);
return Tcl_CancelEval(tsdPtr->interp,
- (result != NULL) ? Tcl_NewStringObj(result, TCL_INDEX_NONE) : NULL, 0, flags);
+ (result != NULL) ? Tcl_NewStringObj(result, -1) : NULL, 0, flags);
}
/*