* 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].

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