diff options
Diffstat (limited to 'generic')
| -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. |