diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2022-01-25 14:22:22 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2022-01-25 14:22:22 (GMT) |
| commit | 016004b79f96bcd0936415f3b901fd79fea50025 (patch) | |
| tree | f97fe6be1b1b0c8d382f2f9aa9a06fbe546b8e10 /generic/tclTest.c | |
| parent | 02d6ad1de92f4d55913948f3b299c6f9c116a9ac (diff) | |
| parent | 831e85b8f62b86995c4a439cccf5ecdc8425cea6 (diff) | |
| download | tcl-016004b79f96bcd0936415f3b901fd79fea50025.zip tcl-016004b79f96bcd0936415f3b901fd79fea50025.tar.gz tcl-016004b79f96bcd0936415f3b901fd79fea50025.tar.bz2 | |
Merge 8.7
Diffstat (limited to 'generic/tclTest.c')
| -rw-r--r-- | generic/tclTest.c | 30 |
1 files changed, 30 insertions, 0 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index d8e5b2f..33d10b5 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -327,6 +327,7 @@ static Tcl_ObjCmdProc TestNumUtfCharsCmd; static Tcl_ObjCmdProc TestFindFirstCmd; static Tcl_ObjCmdProc TestFindLastCmd; static Tcl_ObjCmdProc TestHashSystemHashCmd; +static Tcl_ObjCmdProc TestGetIntForIndexCmd; static Tcl_NRPostProc NREUnwind_callback; static Tcl_ObjCmdProc TestNREUnwind; @@ -598,6 +599,8 @@ Tcltest_Init( TestFindFirstCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindlast", TestFindLastCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testgetintforindex", + TestGetIntForIndexCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsocket", TestSocketCmd, @@ -7041,6 +7044,33 @@ TestFindLastCmd( return TCL_OK; } +static int +TestGetIntForIndexCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + int result; + Tcl_WideInt endvalue; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "index endvalue"); + return TCL_ERROR; + } + + if (Tcl_GetWideIntFromObj(interp, objv[2], &endvalue) != TCL_OK) { + return TCL_ERROR; + } + if (Tcl_GetIntForIndex(interp, objv[1], endvalue, &result) != TCL_OK) { + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result)); + return TCL_OK; +} + + + #if defined(HAVE_CPUID) || defined(_WIN32) /* *---------------------------------------------------------------------- |