diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2014-07-16 10:02:02 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2014-07-16 10:02:02 (GMT) |
commit | 1797998aed8933171252159e04897185043b779a (patch) | |
tree | 17150e3e7f9f402236d0267308e10b72b4cc438a /generic/tclTest.c | |
parent | 0fac79a0fb83abfb15db0859305772d7a64fdc30 (diff) | |
download | tcl-1797998aed8933171252159e04897185043b779a.zip tcl-1797998aed8933171252159e04897185043b779a.tar.gz tcl-1797998aed8933171252159e04897185043b779a.tar.bz2 |
Modify the "gettimes" test-command to use the Tcl_Obj API.
New "testbytestring" command which can be used to replace the (to-be-deprecated) "bytestring" command from tcltest and/or the "indentity" encoding.
Adapt many testcases to use the "testbytestring" command.
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r-- | generic/tclTest.c | 55 |
1 files changed, 48 insertions, 7 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index a27c95a..0f4b6d4 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -201,8 +201,9 @@ static int EncodingFromUtfProc(ClientData clientData, int *dstCharsPtr); static void ExitProcEven(ClientData clientData); static void ExitProcOdd(ClientData clientData); -static int GetTimesCmd(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); +static int GetTimesObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static void MainLoop(void); static int NoopCmd(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); @@ -219,6 +220,9 @@ static void SpecialFree(char *blockPtr); static int StaticInitProc(Tcl_Interp *interp); static int TestasyncCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); +static int TestbytestringObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static int TestcmdinfoCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestcmdtokenCmd(ClientData dummy, @@ -556,9 +560,10 @@ Tcltest_Init( * Create additional commands and math functions for testing Tcl. */ - Tcl_CreateCommand(interp, "gettimes", GetTimesCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, @@ -4717,7 +4722,7 @@ TestgetvarfullnameCmd( /* *---------------------------------------------------------------------- * - * GetTimesCmd -- + * GetTimesObjCmd -- * * This procedure implements the "gettimes" command. It is used for * computing the time needed for various basic operations such as reading @@ -4733,11 +4738,11 @@ TestgetvarfullnameCmd( */ static int -GetTimesCmd( +GetTimesObjCmd( ClientData unused, /* Unused. */ Tcl_Interp *interp, /* The current interpreter. */ - int argc, /* The number of arguments. */ - const char **argv) /* The argument strings. */ + int notused1, /* Number of arguments. */ + Tcl_Obj *const notused2[]) /* The argument objects. */ { Interp *iPtr = (Interp *) interp; int i, n; @@ -4951,6 +4956,42 @@ NoopObjCmd( /* *---------------------------------------------------------------------- * + * TestbytestringObjCmd -- + * + * This object-based procedure constructs a string which can + * possibly contain invalid UTF-8 bytes. + * + * Results: + * Returns the TCL_OK result code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestbytestringObjCmd( + ClientData unused, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ +{ + int n; + const char *p; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "bytearray"); + return TCL_ERROR; + } + p = (const char *)Tcl_GetByteArrayFromObj(objv[1], &n); + Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n)); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TestsetCmd -- * * Implements the "testset{err,noerr}" cmds that are used when testing |