diff options
-rw-r--r-- | generic/tclTest.c | 59 | ||||
-rw-r--r-- | generic/tclUtf.c | 4 | ||||
-rw-r--r-- | unix/tclUnixSock.c | 2 |
3 files changed, 57 insertions, 8 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index 2a43d91..d721787 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -315,6 +315,7 @@ static Tcl_FSListVolumesProc SimpleListVolumes; static Tcl_FSPathInFilesystemProc SimplePathInFilesystem; static Tcl_Obj * SimpleRedirect(Tcl_Obj *pathPtr); static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory; +static Tcl_ObjCmdProc TestUtfNextCmd; static Tcl_ObjCmdProc TestUtfPrevCmd; static Tcl_ObjCmdProc TestNumUtfCharsCmd; static Tcl_ObjCmdProc TestFindFirstCmd; @@ -572,8 +573,10 @@ Tcltest_Init( NULL, NULL); Tcl_CreateObjCommand(interp, "testsetobjerrorcode", TestsetobjerrorcodeCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testutfnext", + TestUtfNextCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testutfprev", - TestUtfPrevCmd, (ClientData) 0, NULL); + TestUtfPrevCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testnumutfchars", TestNumUtfCharsCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindfirst", @@ -6724,6 +6727,52 @@ SimpleListVolumes(void) } /* + * Used to check operations of Tcl_UtfNext. + * + * Usage: testutfnext $bytes $offset + */ + +static int +TestUtfNextCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + int numBytes, offset = 0; + char *bytes; + const char *result; + Tcl_Obj *copy; + + if (objc < 2 || objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "bytes ?offset?"); + return TCL_ERROR; + } + + bytes = (char *) Tcl_GetByteArrayFromObj(objv[1], &numBytes); + + if (objc == 3) { + if (TCL_OK != TclGetIntForIndex(interp, objv[2], numBytes, &offset)) { + return TCL_ERROR; + } + if (offset < 0) { + offset = 0; + } + if (offset > numBytes) { + offset = numBytes; + } + } + copy = Tcl_DuplicateObj(objv[1]); + bytes = (char *) Tcl_SetByteArrayLength(copy, numBytes+1); + bytes[numBytes] = '\0'; + + result = Tcl_UtfNext(bytes + offset); + Tcl_SetObjResult(interp, Tcl_NewIntObj(result - bytes)); + + Tcl_DecrRefCount(copy); + return TCL_OK; +} +/* * Used to check operations of Tcl_UtfPrev. * * Usage: testutfprev $bytes $offset @@ -6740,16 +6789,16 @@ TestUtfPrevCmd( char *bytes; const char *result; Tcl_Obj *copy; - + if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "bytes ?offset?"); return TCL_ERROR; } bytes = (char *) Tcl_GetByteArrayFromObj(objv[1], &numBytes); - + if (objc == 3) { - if (TCL_OK != Tcl_GetIntFromObj(interp, objv[2], &offset)) { + if (TCL_OK != TclGetIntForIndex(interp, objv[2], numBytes, &offset)) { return TCL_ERROR; } if (offset < 0) { @@ -6766,9 +6815,9 @@ TestUtfPrevCmd( bytes[numBytes] = '\0'; result = Tcl_UtfPrev(bytes + offset, bytes); + Tcl_SetObjResult(interp, Tcl_NewIntObj(result - bytes)); Tcl_DecrRefCount(copy); - Tcl_SetObjResult(interp, Tcl_NewIntObj(result - bytes)); return TCL_OK; } diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 3377b70..ec9bffd 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -698,7 +698,7 @@ Tcl_UtfNext( * starts a character when characters are read starting at start and * that character might include the byte src[-1]. The routine will * examine only those bytes in the range that might be returned. - * It will not examine the byte *src, and because of that cannot + * It will not examine the byte *src, and because of that cannot * determine for certain in all circumstances whether the character * that begins with the returned pointer will or will not include * the byte src[-1]. In the scenario, where src points to the end of @@ -713,7 +713,7 @@ Tcl_UtfNext( * prevented from running past the beginning of the string. * * In a string where all characters are complete and properly formed, - * and the value of src points to the first byte of a character, + * and the value of src points to the first byte of a character, * repeated Tcl_UtfPrev calls will step to the starting bytes of * characters, one character at a time. Within those limitations, * Tcl_UtfPrev and Tcl_UtfNext are inverses. If either condition cannot diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 4d7a8fb..8537207 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -984,7 +984,7 @@ TcpThreadActionProc( if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { /* * Async-connecting socket must get reassigned handler if it have been - * transferred to another thread. Remove the handler if the socket is + * transferred to another thread. Remove the handler if the socket is * not managed by this thread anymore and create new handler (TSD related) * so the callback will run in the correct thread, bug [f583715154]. */ |