summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorericm <ericm>2000-08-07 22:42:31 (GMT)
committerericm <ericm>2000-08-07 22:42:31 (GMT)
commit6010721a7deebd7a9b038b2ae93b4d8bd8f7cb24 (patch)
tree61d50d1446176d04a1b82fa826f3b9a3afbaa10e /generic
parent17cf10d104c7cd7e936cbab403f027b19d3ac265 (diff)
downloadtcl-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.c12
-rw-r--r--generic/tclTest.c64
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;
+}