diff options
| author | dgp <dgp@users.sourceforge.net> | 2016-12-19 18:40:20 (GMT) |
|---|---|---|
| committer | dgp <dgp@users.sourceforge.net> | 2016-12-19 18:40:20 (GMT) |
| commit | f686f85172211e14524a25e39599175267f38543 (patch) | |
| tree | cd05833ffac86646efc12a04c5bf8496e08002ec /generic/tclTest.c | |
| parent | ee9cd7ebb808aab98737dbcd80c155b685b3afae (diff) | |
| parent | d68b61bd1e37b1916ebffdd989270c2d0e8ffccd (diff) | |
| download | tcl-f686f85172211e14524a25e39599175267f38543.zip tcl-f686f85172211e14524a25e39599175267f38543.tar.gz tcl-f686f85172211e14524a25e39599175267f38543.tar.bz2 | |
merge novem
Diffstat (limited to 'generic/tclTest.c')
| -rw-r--r-- | generic/tclTest.c | 42 |
1 files changed, 42 insertions, 0 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index d554c54..30ceee0 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -305,6 +305,9 @@ static int TestparsevarnameObjCmd(ClientData dummy, static int TestpreferstableObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int TestprintObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static int TestregexpObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -630,6 +633,8 @@ Tcltest_Init( NULL, NULL); Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd, + NULL, NULL); Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, @@ -3652,6 +3657,43 @@ TestpreferstableObjCmd( /* *---------------------------------------------------------------------- * + * TestprintObjCmd -- + * + * This procedure implements the "testprint" command. It is + * used for being able to test the Tcl_ObjPrintf() function. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestprintObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ +{ + Tcl_WideInt argv1 = 0; + + if (objc < 2 || objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "format wideint"); + } + + if (objc > 1) { + Tcl_GetWideIntFromObj(interp, objv[2], &argv1); + } + Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1)); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TestregexpObjCmd -- * * This procedure implements the "testregexp" command. It is used to give |