diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2022-01-21 08:53:56 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2022-01-21 08:53:56 (GMT) |
| commit | 65ca3bc25beba08d22f9f216316ea719236eacc4 (patch) | |
| tree | 36698f2a361c6024031bb23cd0e99685df4267d1 /generic/tclTest.c | |
| parent | d0b286927306af8bde7031529ad180eaa07dcc73 (diff) | |
| parent | e433c571581eae56161e5c4dc8dcae36e31d8039 (diff) | |
| download | tcl-65ca3bc25beba08d22f9f216316ea719236eacc4.zip tcl-65ca3bc25beba08d22f9f216316ea719236eacc4.tar.gz tcl-65ca3bc25beba08d22f9f216316ea719236eacc4.tar.bz2 | |
Fix bug in Tcl_GetIntForIndex() (TIP #544), discovered when investigating [https://core.tcl-lang.org/tk/tktview?name=a9929f112a|a9929f112a]
Diffstat (limited to 'generic/tclTest.c')
| -rw-r--r-- | generic/tclTest.c | 29 |
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) /* *---------------------------------------------------------------------- |