summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2022-01-21 08:43:13 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2022-01-21 08:43:13 (GMT)
commite433c571581eae56161e5c4dc8dcae36e31d8039 (patch)
tree36698f2a361c6024031bb23cd0e99685df4267d1 /generic/tclTest.c
parentb97786c85dbd70fd4445f8161b205d5dbc56e844 (diff)
downloadtcl-e433c571581eae56161e5c4dc8dcae36e31d8039.zip
tcl-e433c571581eae56161e5c4dc8dcae36e31d8039.tar.gz
tcl-e433c571581eae56161e5c4dc8dcae36e31d8039.tar.bz2
Add test-cases for Tcl_GetIntForIndex(). This reveals a minor bug
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c29
1 files changed, 29 insertions, 0 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 7ec3c41..95ef5b7 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,
@@ -7036,6 +7039,32 @@ TestFindLastCmd(
return TCL_OK;
}
+static int
+TestGetIntForIndexCmd(
+ TCL_UNUSED(void *),
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ int result, endvalue;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "index endvalue");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(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_NewIntObj(result));
+ return TCL_OK;
+}
+
+
+
#if defined(HAVE_CPUID) || defined(_WIN32)
/*
*----------------------------------------------------------------------