diff options
author | dgp <dgp@noemail.net> | 2008-03-07 20:26:21 (GMT) |
---|---|---|
committer | dgp <dgp@noemail.net> | 2008-03-07 20:26:21 (GMT) |
commit | 162cf7c9ace1873eae5f59150a950f96e131a5c1 (patch) | |
tree | 6383517f43bf7bab71c1a1354a2595615d61333a /generic/tclTest.c | |
parent | f220279df36421176a1204acf35e86961b9556ca (diff) | |
download | tcl-162cf7c9ace1873eae5f59150a950f96e131a5c1.zip tcl-162cf7c9ace1873eae5f59150a950f96e131a5c1.tar.gz tcl-162cf7c9ace1873eae5f59150a950f96e131a5c1.tar.bz2 |
* generic/tclTest.c: Backport the [testexprlongobj] testing command.
FossilOrigin-Name: a7270a4413b7a7ba80882c09e9496682533e8200
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r-- | generic/tclTest.c | 49 |
1 files changed, 48 insertions, 1 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index 433444b..2b9bab0 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.14 2007/06/27 17:29:23 dgp Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.62.2.15 2008/03/07 20:26:22 dgp Exp $ */ #define TCL_TEST @@ -240,6 +240,9 @@ static int TestexithandlerCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static int TestexprlongCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); +static int TestexprlongobjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); static int TestexprparserObjCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); @@ -613,6 +616,8 @@ Tcltest_Init(interp) (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testexprlong", TestexprlongCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "testexprlongobj", TestexprlongobjCmd, + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "testexprparser", TestexprparserObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testexprstring", TestexprstringCmd, @@ -2262,6 +2267,48 @@ TestexprlongCmd(clientData, interp, argc, argv) /* *---------------------------------------------------------------------- * + * TestexprlongobjCmd -- + * + * This procedure verifies that Tcl_ExprLongObj does not modify the + * interpreter result if there is no error. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestexprlongobjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST *objv; /* Argument objects. */ +{ + long exprResult; + char buf[4 + TCL_INTEGER_SPACE]; + int result; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "expression"); + return TCL_ERROR; + } + Tcl_SetResult(interp, "This is a result", TCL_STATIC); + result = Tcl_ExprLongObj(interp, objv[1], &exprResult); + if (result != TCL_OK) { + return result; + } + sprintf(buf, ": %ld", exprResult); + Tcl_AppendResult(interp, buf, NULL); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TestexprstringCmd -- * * This procedure tests the basic operation of Tcl_ExprString. |