summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog12
-rw-r--r--generic/tclIndexObj.c12
-rw-r--r--generic/tclTest.c64
-rw-r--r--tests/indexObj.test21
4 files changed, 104 insertions, 5 deletions
diff --git a/ChangeLog b/ChangeLog
index 4bef5c9..a6b158d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2000-08-07 Eric Melski <ericm@ajubasolutions.com>
+
+ * 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].
+
2000-07-27 Mo DeJong <mdejong@redhat.com>
* win/configure.in: TCL_STUB_LIB_FLAG should not
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;
+}
diff --git a/tests/indexObj.test b/tests/indexObj.test
index 6a69a9d..4dd83f5 100644
--- a/tests/indexObj.test
+++ b/tests/indexObj.test
@@ -8,7 +8,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: indexObj.test,v 1.5 2000/04/10 17:19:00 ericm Exp $
+# RCS: @(#) $Id: indexObj.test,v 1.6 2000/08/07 22:42:32 ericm Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -70,6 +70,25 @@ test indexObj-4.1 {free old internal representation} {
testindexobj 1 1 $x abc def {a b} zzz
} {2}
+test indexObj-5.1 {Tcl_WrongNumArgs} {
+ testwrongnumargs 1 "?option?" mycmd
+} "wrong # args: should be \"mycmd ?option?\""
+test indexObj-5.2 {Tcl_WrongNumArgs} {
+ testwrongnumargs 2 "bar" mycmd foo
+} "wrong # args: should be \"mycmd foo bar\""
+test indexObj-5.3 {Tcl_WrongNumArgs} {
+ testwrongnumargs 0 "bar" mycmd foo
+} "wrong # args: should be \"bar\""
+test indexObj-5.4 {Tcl_WrongNumArgs} {
+ testwrongnumargs 0 "" mycmd foo
+} "wrong # args: should be \"\""
+test indexObj-5.5 {Tcl_WrongNumArgs} {
+ testwrongnumargs 1 "" mycmd foo
+} "wrong # args: should be \"mycmd\""
+test indexObj-5.6 {Tcl_WrongNumArgs} {
+ testwrongnumargs 2 "" mycmd foo
+} "wrong # args: should be \"mycmd foo\""
+
# cleanup
::tcltest::cleanupTests
return