summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2000-11-24 11:27:37 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2000-11-24 11:27:37 (GMT)
commitf8076c7264ff06e9d94f8d12f79697879c54b147 (patch)
tree04cbf71084d0140cae333ababd2f11c658ef988d /generic/tclTest.c
parentca54557b2a7a3ca47409fdf201e2e15bdd642741 (diff)
downloadtcl-f8076c7264ff06e9d94f8d12f79697879c54b147.zip
tcl-f8076c7264ff06e9d94f8d12f79697879c54b147.tar.gz
tcl-f8076c7264ff06e9d94f8d12f79697879c54b147.tar.bz2
Now correctly test for (and fix) Bug #119082.
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c58
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;
+}