diff options
| -rw-r--r-- | generic/tclTest.c | 43 | ||||
| -rw-r--r-- | generic/tclTestObj.c | 2 | ||||
| -rw-r--r-- | generic/tclTestProcBodyObj.c | 6 | ||||
| -rw-r--r-- | generic/tclThreadTest.c | 8 |
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); } /* |
