diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2022-01-21 11:11:28 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2022-01-21 11:11:28 (GMT) |
| commit | 37b655adbfe82ac129c013442a5ef951cb1316a3 (patch) | |
| tree | 9d32e1aa91bc89ace8d97ccd8b69b4209b3e8635 /generic/tclTest.c | |
| parent | 984fc40963c8de57bef4a2d8d4317b692df59067 (diff) | |
| parent | 65ca3bc25beba08d22f9f216316ea719236eacc4 (diff) | |
| download | tcl-37b655adbfe82ac129c013442a5ef951cb1316a3.zip tcl-37b655adbfe82ac129c013442a5ef951cb1316a3.tar.gz tcl-37b655adbfe82ac129c013442a5ef951cb1316a3.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 c182d98..91239a9 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -324,6 +324,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; @@ -595,6 +596,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, @@ -7038,6 +7041,33 @@ TestFindLastCmd( return TCL_OK; } +static int +TestGetIntForIndexCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + size_t 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) /* *---------------------------------------------------------------------- |