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 | |
parent | 984fc40963c8de57bef4a2d8d4317b692df59067 (diff) | |
parent | 65ca3bc25beba08d22f9f216316ea719236eacc4 (diff) | |
download | tcl-37b655adbfe82ac129c013442a5ef951cb1316a3.zip tcl-37b655adbfe82ac129c013442a5ef951cb1316a3.tar.gz tcl-37b655adbfe82ac129c013442a5ef951cb1316a3.tar.bz2 |
Merge 8.7
-rw-r--r-- | generic/tclTest.c | 30 | ||||
-rw-r--r-- | generic/tclUtil.c | 6 | ||||
-rw-r--r-- | tests/indexObj.test | 47 |
3 files changed, 79 insertions, 4 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) /* *---------------------------------------------------------------------- diff --git a/generic/tclUtil.c b/generic/tclUtil.c index b4743d1..3aceb67 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3405,9 +3405,9 @@ Tcl_GetIntForIndex( return TCL_ERROR; } if (indexPtr != NULL) { - if ((wide < 0) && (endValue != TCL_INDEX_END)) { + if ((wide < 0) && (endValue < TCL_INDEX_END)) { *indexPtr = TCL_INDEX_NONE; - } else if ((Tcl_WideUInt)wide > TCL_INDEX_END) { + } else if ((Tcl_WideUInt)wide > TCL_INDEX_END && (endValue < TCL_INDEX_END)) { *indexPtr = TCL_INDEX_END; } else { *indexPtr = (size_t) wide; @@ -3651,8 +3651,6 @@ GetEndOffsetFromObj( *widePtr = endValue + 1; } else if (offset == WIDE_MIN) { *widePtr = -1; - } else if (endValue == (size_t)-1) { - *widePtr = offset; } else if (offset < 0) { /* Different signs, sum cannot overflow */ *widePtr = endValue + offset + 1; diff --git a/tests/indexObj.test b/tests/indexObj.test index 40418b3..f7a555a 100644 --- a/tests/indexObj.test +++ b/tests/indexObj.test @@ -17,6 +17,7 @@ if {"::tcltest" ni [namespace children]} { catch [list package require -exact tcl::test [info patchlevel]] testConstraint testindexobj [llength [info commands testindexobj]] +testConstraint testgetintforindex [llength [info commands testgetintforindex]] testConstraint testparseargs [llength [info commands testparseargs]] test indexObj-1.1 {exact match} testindexobj { @@ -165,6 +166,52 @@ test indexObj-7.7 {Tcl_ParseArgsObjv memory management} testparseargs { testparseargs 1 2 3 4 5 6 7 8 9 0 -bool 1 2 3 4 5 6 7 8 9 0 } {1 21 {testparseargs 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0}} +test indexObj-8.1 {Tcl_GetIntForIndex integer} testgetintforindex { + testgetintforindex 0 0 +} 0 +test indexObj-8.2 {Tcl_GetIntForIndex integer} testgetintforindex { + testgetintforindex -1 0 +} -1 +test indexObj-8.3 {Tcl_GetIntForIndex integer} testgetintforindex { + testgetintforindex -2 0 +} -1 +test indexObj-8.4 {Tcl_GetIntForIndex INT_MAX} testgetintforindex { + testgetintforindex 2147483647 0 +} 2147483647 +test indexObj-8.5 {Tcl_GetIntForIndex INT_MAX+1} testgetintforindex { + testgetintforindex 2147483648 0 +} 2147483648 +test indexObj-8.6 {Tcl_GetIntForIndex end-1} testgetintforindex { + testgetintforindex end-1 2147483646 +} 2147483645 +test indexObj-8.7 {Tcl_GetIntForIndex end-1} testgetintforindex { + testgetintforindex end-1 2147483647 +} 2147483646 +test indexObj-8.8 {Tcl_GetIntForIndex end} testgetintforindex { + testgetintforindex end 2147483646 +} 2147483646 +test indexObj-8.9 {Tcl_GetIntForIndex end} testgetintforindex { + testgetintforindex end 2147483647 +} 2147483647 +test indexObj-8.10 {Tcl_GetIntForIndex end-1} testgetintforindex { + testgetintforindex end-1 -1 +} -2 +test indexObj-8.11 {Tcl_GetIntForIndex end-1} testgetintforindex { + testgetintforindex end-1 -2 +} -3 +test indexObj-8.12 {Tcl_GetIntForIndex end} testgetintforindex { + testgetintforindex end -1 +} -1 +test indexObj-8.13 {Tcl_GetIntForIndex end} testgetintforindex { + testgetintforindex end -2 +} -2 +test indexObj-8.14 {Tcl_GetIntForIndex end+1} testgetintforindex { + testgetintforindex end+1 -1 +} 0 +test indexObj-8.15 {Tcl_GetIntForIndex end+1} testgetintforindex { + testgetintforindex end+1 -2 +} -1 + # cleanup ::tcltest::cleanupTests return |