Now correctly test for (and fix) Bug #119082.

1 files changed, 57 insertions, 1 deletions

diff --git a/generic/tclTest.c b/generic/tclTest.c
index b76b978..c27e7e2 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.21 2000/09/28 06:38:22 hobbs Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.22 2000/11/24 11:27:37 dkf Exp $
  */
 
 #define TCL_TEST
@@ -292,6 +292,9 @@ static int		TestupvarCmd _ANSI_ARGS_((ClientData dummy,
 static int              TestWrongNumArgsObjCmd _ANSI_ARGS_((
 			    ClientData clientData, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]));
+static int              TestGetIndexFromObjStructObjCmd _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,
@@ -347,6 +350,9 @@ Tcltest_Init(interp)
 	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
 	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct",
+			 TestGetIndexFromObjStructObjCmd, (ClientData) 0,
+			 (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testaccessproc", TestaccessprocCmd, (ClientData) 0,
 	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0,
@@ -4947,3 +4953,53 @@ TestWrongNumArgsObjCmd(dummy, interp, objc, objv)
     Tcl_WrongNumArgs(interp, i, &(objv[3]), msg);
     return TCL_OK;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestGetIndexFromObjStructObjCmd --
+ *
+ *	Test the Tcl_GetIndexFromObjStruct function.
+ *
+ * Results:
+ *	Standard Tcl result.
+ *
+ * Side effects:
+ *	Sets interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    char *ary[] = { "a", "b", "c", "d", "e", "f", (char *)NULL,(char *)NULL };
+    int idx,target;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "argument targetvalue");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIndexFromObjStruct(interp, objv[1], ary, 2*sizeof(char *),
+				  "dummy", 0, &idx) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIntFromObj(interp, objv[2], &target) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (idx != target) {
+	char buffer[64];
+	sprintf(buffer, "%d", idx);
+	Tcl_AppendResult(interp, "index value comparison failed: got ",
+			 buffer, NULL);
+	sprintf(buffer, "%d", target);
+	Tcl_AppendResult(interp, " when ", buffer, " expected", NULL);
+	return TCL_ERROR;
+    }
+    Tcl_WrongNumArgs(interp, 3, objv, NULL);
+    return TCL_OK;
+}