diff options
| author | apnadkarni <apnmbx-wits@yahoo.com> | 2023-09-05 06:42:31 (GMT) |
|---|---|---|
| committer | apnadkarni <apnmbx-wits@yahoo.com> | 2023-09-05 06:42:31 (GMT) |
| commit | 1de4b18af94b1835fbaf130e84d9115bb2f387b0 (patch) | |
| tree | efd2e16200a03f7cd625482d63a10a3e958b23f0 /generic | |
| parent | e1edaf47153bf88f19d2def15b703e510006fde7 (diff) | |
| parent | 381c827ae8477c27cb4291cb0fa9c5f84581730c (diff) | |
| download | tcl-1de4b18af94b1835fbaf130e84d9115bb2f387b0.zip tcl-1de4b18af94b1835fbaf130e84d9115bb2f387b0.tar.gz tcl-1de4b18af94b1835fbaf130e84d9115bb2f387b0.tar.bz2 | |
Merge 8.6 - Fix [b5ac3e3786] - Tcl_GetUniChar oob read
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclStringObj.c | 3 | ||||
| -rw-r--r-- | generic/tclTest.c | 31 |
2 files changed, 34 insertions, 0 deletions
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 490ddf9..251cf66 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -862,6 +862,9 @@ TclGetUniChar( if (stringPtr->numChars == -1) { TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length); } + if (index >= stringPtr->numChars) { + return -1; + } if (stringPtr->numChars == objPtr->length) { return (unsigned char) objPtr->bytes[index]; } diff --git a/generic/tclTest.c b/generic/tclTest.c index 83dad7d..abfa0ad 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -358,6 +358,7 @@ static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory; static Tcl_ObjCmdProc TestUtfNextCmd; static Tcl_ObjCmdProc TestUtfPrevCmd; static Tcl_ObjCmdProc TestNumUtfCharsCmd; +static Tcl_ObjCmdProc TestGetUniCharCmd; static Tcl_ObjCmdProc TestFindFirstCmd; static Tcl_ObjCmdProc TestFindLastCmd; static Tcl_ObjCmdProc TestHashSystemHashCmd; @@ -718,6 +719,8 @@ Tcltest_Init( TestUtfPrevCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testnumutfchars", TestNumUtfCharsCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testgetunichar", + TestGetUniCharCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindfirst", TestFindFirstCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindlast", @@ -7754,6 +7757,34 @@ TestNumUtfCharsCmd( return TCL_OK; } + +/* + * Used to check correct operation of Tcl_GetUniChar + * testgetunichar STRING INDEX + * This differs from just using "string index" in being a direct + * call to Tcl_GetUniChar without any prior range checking. + */ +static int +TestGetUniCharCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter */ + int objc, /* Number of arguments */ + Tcl_Obj *const objv[] /* Argument strings */ + ) +{ + int index; + int c ; + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "STRING INDEX"); + return TCL_ERROR; + } + Tcl_GetIntFromObj(interp, objv[2], &index); + c = Tcl_GetUniChar(objv[1], index); + Tcl_SetObjResult(interp, Tcl_NewIntObj(c)); + + return TCL_OK; +} + /* * Used to check correct operation of Tcl_UtfFindFirst */ |