diff options
Diffstat (limited to 'generic/tclTest.c')
| -rw-r--r-- | generic/tclTest.c | 30 |
1 files changed, 28 insertions, 2 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index 327c470..d3abdfb 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTest.c,v 1.62.2.1 2003/04/16 23:31:46 dgp Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.62.2.2 2003/10/08 14:21:20 dkf Exp $ */ #define TCL_TEST @@ -420,6 +420,9 @@ static Tcl_Obj* SimpleListVolumes _ANSI_ARGS_ ((void)); static int SimplePathInFilesystem _ANSI_ARGS_ (( Tcl_Obj *pathPtr, ClientData *clientDataPtr)); static Tcl_Obj* SimpleCopy _ANSI_ARGS_ ((Tcl_Obj *pathPtr)); +static int TestNumUtfCharsCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); static Tcl_Filesystem testReportingFilesystem = { "reporting", @@ -654,6 +657,9 @@ Tcltest_Init(interp) Tcl_CreateObjCommand(interp, "testsetobjerrorcode", TestsetobjerrorcodeCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "testnumutfchars", + TestNumUtfCharsCmd, (ClientData) 0, + (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd, @@ -6423,4 +6429,24 @@ SimpleListVolumes(void) Tcl_IncrRefCount(retVal); return retVal; } - + +/* + * Used to check correct string-length determining in Tcl_NumUtfChars + */ +static int +TestNumUtfCharsCmd(clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + if (objc > 1) { + int len = -1; + if (objc > 2) { + (void) Tcl_GetStringFromObj(objv[1], &len); + } + len = Tcl_NumUtfChars(Tcl_GetString(objv[1]), len); + Tcl_SetObjResult(interp, Tcl_NewIntObj(len)); + } + return TCL_OK; +} |