diff options
Diffstat (limited to 'generic/tclTest.c')
| -rw-r--r-- | generic/tclTest.c | 59 |
1 files changed, 54 insertions, 5 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index 31d3a7f..ba25873 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -433,6 +433,7 @@ static int SimpleMatchInDirectory( Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *dirPtr, const char *pattern, Tcl_GlobTypeData *types); +static Tcl_ObjCmdProc TestUtfNextCmd; static Tcl_ObjCmdProc TestUtfPrevCmd; static int TestNumUtfCharsCmd(ClientData clientData, Tcl_Interp *interp, int objc, @@ -697,8 +698,10 @@ Tcltest_Init( (ClientData) 0, 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", @@ -7107,6 +7110,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 @@ -7123,16 +7172,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) { @@ -7149,9 +7198,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; } |