Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Fix bug in Tcl_GetIntForIndex() (TIP #544), discovered when investigating [https://core.tcl-lang.org/tk/tktview?name=a9929f112a|a9929f112a] |
|---|---|
| Timelines: | family | ancestors | descendants | both | core-8-branch |
| Files: | files | file ages | folders |
| SHA3-256: |
96a8baa3c992b938c2ef9647ea4985dd |
| User & Date: | jan.nijtmans 2022-01-21 08:53:56.024 |
Context
|
2022-01-21
| ||
| 15:15 | Merge 8.6 check-in: 2306f87127 user: jan.nijtmans tags: core-8-branch | |
| 11:11 | Merge 8.7 check-in: ebedbf9a12 user: jan.nijtmans tags: trunk, main | |
| 08:53 | Fix bug in Tcl_GetIntForIndex() (TIP #544), discovered when investigating [https://core.tcl-lang.org... check-in: 96a8baa3c9 user: jan.nijtmans tags: core-8-branch | |
| 08:43 | Add test-cases for Tcl_GetIntForIndex(). This reveals a minor bug Closed-Leaf check-in: 2858475ed7 user: jan.nijtmans tags: bug-a9929f112a | |
|
2022-01-18
| ||
| 23:26 | Update documentation for Tcl_GetRange() check-in: 61b142d29c user: jan.nijtmans tags: core-8-branch | |
Changes
Changes to generic/tclTest.c.
| ︙ | ︙ | |||
323 324 325 326 327 328 329 330 331 332 333 334 335 336 | static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory; static Tcl_ObjCmdProc TestUtfNextCmd; static Tcl_ObjCmdProc TestUtfPrevCmd; static Tcl_ObjCmdProc TestNumUtfCharsCmd; static Tcl_ObjCmdProc TestFindFirstCmd; static Tcl_ObjCmdProc TestFindLastCmd; static Tcl_ObjCmdProc TestHashSystemHashCmd; static Tcl_NRPostProc NREUnwind_callback; static Tcl_ObjCmdProc TestNREUnwind; static Tcl_ObjCmdProc TestNRELevels; static Tcl_ObjCmdProc TestInterpResolverCmd; #if defined(HAVE_CPUID) || defined(_WIN32) static Tcl_ObjCmdProc TestcpuidCmd; | > | 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 | static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory; static Tcl_ObjCmdProc TestUtfNextCmd; static Tcl_ObjCmdProc TestUtfPrevCmd; 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; static Tcl_ObjCmdProc TestNRELevels; static Tcl_ObjCmdProc TestInterpResolverCmd; #if defined(HAVE_CPUID) || defined(_WIN32) static Tcl_ObjCmdProc TestcpuidCmd; |
| ︙ | ︙ | |||
594 595 596 597 598 599 600 601 602 603 604 605 606 607 |
TestUtfPrevCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testnumutfchars",
TestNumUtfCharsCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testfindfirst",
TestFindFirstCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testfindlast",
TestFindLastCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testsocket", TestSocketCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "teststaticlibrary", TeststaticlibraryCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testtranslatefilename",
| > > | 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 |
TestUtfPrevCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testnumutfchars",
TestNumUtfCharsCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testfindfirst",
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,
NULL, NULL);
Tcl_CreateCommand(interp, "teststaticlibrary", TeststaticlibraryCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testtranslatefilename",
|
| ︙ | ︙ | |||
7031 7032 7033 7034 7035 7036 7037 7038 7039 7040 7041 7042 7043 7044 |
if (objc > 2) {
(void) Tcl_GetIntFromObj(interp, objv[2], &len);
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1));
}
return TCL_OK;
}
#if defined(HAVE_CPUID) || defined(_WIN32)
/*
*----------------------------------------------------------------------
*
* TestcpuidCmd --
*
| > > > > > > > > > > > > > > > > > > > > > > > > > > | 7034 7035 7036 7037 7038 7039 7040 7041 7042 7043 7044 7045 7046 7047 7048 7049 7050 7051 7052 7053 7054 7055 7056 7057 7058 7059 7060 7061 7062 7063 7064 7065 7066 7067 7068 7069 7070 7071 7072 7073 |
if (objc > 2) {
(void) Tcl_GetIntFromObj(interp, objv[2], &len);
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1));
}
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)
/*
*----------------------------------------------------------------------
*
* TestcpuidCmd --
*
|
| ︙ | ︙ |
Changes to generic/tclUtil.c.
| ︙ | ︙ | |||
3699 3700 3701 3702 3703 3704 3705 |
{
Tcl_WideInt wide;
if (GetWideForIndex(interp, objPtr, (size_t)(endValue + 1) - 1, &wide) == TCL_ERROR) {
return TCL_ERROR;
}
if (indexPtr != NULL) {
| | | 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 |
{
Tcl_WideInt wide;
if (GetWideForIndex(interp, objPtr, (size_t)(endValue + 1) - 1, &wide) == TCL_ERROR) {
return TCL_ERROR;
}
if (indexPtr != NULL) {
if ((wide < 0) && (endValue >= 0)) {
*indexPtr = -1;
} else if (wide > INT_MAX) {
*indexPtr = INT_MAX;
} else if (wide < INT_MIN) {
*indexPtr = INT_MIN;
} else {
*indexPtr = (int) wide;
|
| ︙ | ︙ |
Changes to tests/indexObj.test.
| ︙ | ︙ | |||
13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint testindexobj [llength [info commands testindexobj]]
testConstraint testparseargs [llength [info commands testparseargs]]
test indexObj-1.1 {exact match} testindexobj {
testindexobj 1 1 xyz abc def xyz alm
} {2}
test indexObj-1.2 {exact match} testindexobj {
testindexobj 1 1 abc abc def xyz alm
| > | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 |
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
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 {
testindexobj 1 1 xyz abc def xyz alm
} {2}
test indexObj-1.2 {exact match} testindexobj {
testindexobj 1 1 abc abc def xyz alm
|
| ︙ | ︙ | |||
161 162 163 164 165 166 167 168 169 170 171 172 173 174 |
test indexObj-7.6 {Tcl_ParseArgsObjv} testparseargs {
testparseargs -- -bool -help
} {0 3 {testparseargs -bool -help}}
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}}
# cleanup
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# End:
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 |
test indexObj-7.6 {Tcl_ParseArgsObjv} testparseargs {
testparseargs -- -bool -help
} {0 3 {testparseargs -bool -help}}
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
} 2147483647
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
# Local Variables:
# mode: tcl
# End:
|