diff options
author | ericm <ericm> | 2000-08-07 22:42:31 (GMT) |
---|---|---|
committer | ericm <ericm> | 2000-08-07 22:42:31 (GMT) |
commit | 6010721a7deebd7a9b038b2ae93b4d8bd8f7cb24 (patch) | |
tree | 61d50d1446176d04a1b82fa826f3b9a3afbaa10e /generic | |
parent | 17cf10d104c7cd7e936cbab403f027b19d3ac265 (diff) | |
download | tcl-6010721a7deebd7a9b038b2ae93b4d8bd8f7cb24.zip tcl-6010721a7deebd7a9b038b2ae93b4d8bd8f7cb24.tar.gz tcl-6010721a7deebd7a9b038b2ae93b4d8bd8f7cb24.tar.bz2 |
* tests/indexObj.test: Added tests using the [testwrongnumargs]
command to test Tcl_WrongNumArgs.
* generic/tclTest.c (TestWrongNumArgsObjCmd): Added test function
for the Tcl_WrongNumArgs function.
* generic/tclIndexObj.c (Tcl_WrongNumArgs): Corrected algorithm to
not insert a space before the message component when objc == 0
[Bug: 6078].
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclIndexObj.c | 12 | ||||
-rw-r--r-- | generic/tclTest.c | 64 |
2 files changed, 72 insertions, 4 deletions
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 7e60153..49bbe63 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIndexObj.c,v 1.5 2000/06/06 19:34:34 hobbs Exp $ + * RCS: @(#) $Id: tclIndexObj.c,v 1.6 2000/08/07 22:42:31 ericm Exp $ */ #include "tclInt.h" @@ -334,12 +334,18 @@ Tcl_WrongNumArgs(interp, objc, objv, message) Tcl_AppendStringsToObj(objPtr, Tcl_GetString(objv[i]), (char *) NULL); } - if (i < (objc - 1)) { + + /* + * Append a space character (" ") if there is more text to follow + * (either another element from objv, or the message string). + */ + if ((i < (objc - 1)) || message) { Tcl_AppendStringsToObj(objPtr, " ", (char *) NULL); } } + if (message) { - Tcl_AppendStringsToObj(objPtr, " ", message, (char *) NULL); + Tcl_AppendStringsToObj(objPtr, message, (char *) NULL); } Tcl_AppendStringsToObj(objPtr, "\"", (char *) NULL); } diff --git a/generic/tclTest.c b/generic/tclTest.c index 085d99c..6f90e20 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -13,7 +13,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.19 2000/07/26 01:28:49 davidg Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.20 2000/08/07 22:42:31 ericm Exp $ */ #define TCL_TEST @@ -290,6 +290,10 @@ static int TesttranslatefilenameCmd _ANSI_ARGS_((ClientData dummy, static int TestupvarCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); +static int TestWrongNumArgsObjCmd _ANSI_ARGS_(( + ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); static int TestChannelCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); static int TestChannelEventCmd _ANSI_ARGS_((ClientData clientData, @@ -343,6 +347,8 @@ Tcltest_Init(interp) (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd, + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testaccessproc", TestaccessprocCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0, @@ -4849,3 +4855,59 @@ TestChannelEventCmd(dummy, interp, argc, argv) "add, delete, list, set, or removeall", (char *) NULL); return TCL_ERROR; } + +/* + *---------------------------------------------------------------------- + * + * TestWrongNumArgsObjCmd -- + * + * Test the Tcl_WrongNumArgs function. + * + * Results: + * Standard Tcl result. + * + * Side effects: + * Sets interpreter result. + * + *---------------------------------------------------------------------- + */ + +static int +TestWrongNumArgsObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + int i, length; + char *msg; + + if (objc < 3) { + /* + * Don't use Tcl_WrongNumArgs here, as that is the function + * we want to test! + */ + Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC); + return TCL_ERROR; + } + + if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) { + return TCL_ERROR; + } + + msg = Tcl_GetStringFromObj(objv[2], &length); + if (length == 0) { + msg = NULL; + } + + if (i > objc - 3) { + /* + * Asked for more arguments than were given. + */ + Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC); + return TCL_ERROR; + } + + Tcl_WrongNumArgs(interp, i, &(objv[3]), msg); + return TCL_OK; +} |