summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2022-01-21 11:11:28 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2022-01-21 11:11:28 (GMT)
commit37b655adbfe82ac129c013442a5ef951cb1316a3 (patch)
tree9d32e1aa91bc89ace8d97ccd8b69b4209b3e8635
parent984fc40963c8de57bef4a2d8d4317b692df59067 (diff)
parent65ca3bc25beba08d22f9f216316ea719236eacc4 (diff)
downloadtcl-37b655adbfe82ac129c013442a5ef951cb1316a3.zip
tcl-37b655adbfe82ac129c013442a5ef951cb1316a3.tar.gz
tcl-37b655adbfe82ac129c013442a5ef951cb1316a3.tar.bz2
Merge 8.7
-rw-r--r--generic/tclTest.c30
-rw-r--r--generic/tclUtil.c6
-rw-r--r--tests/indexObj.test47
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