summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2011-09-27 09:45:40 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2011-09-27 09:45:40 (GMT)
commita235eed74f319d7860e973935e2064bd1bb30e18 (patch)
tree12aafa760ef15e0e28c6fdb7b43fb2de959f2cca /generic
parent0f5c9c8a346e3b691776746c83dfa947b2f41fd6 (diff)
downloadtcl-a235eed74f319d7860e973935e2064bd1bb30e18.zip
tcl-a235eed74f319d7860e973935e2064bd1bb30e18.tar.gz
tcl-a235eed74f319d7860e973935e2064bd1bb30e18.tar.bz2
Test harness for Tcl_ParseArgsObjvbug_3413857
Diffstat (limited to 'generic')
-rw-r--r--generic/tclTest.c45
1 files changed, 45 insertions, 0 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 96dcb36..5b74663 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -311,6 +311,8 @@ static int TestpanicCmd(ClientData dummy,
static int TestfinexitObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+static int TestparseargsCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
static int TestparserObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -624,6 +626,7 @@ Tcltest_Init(
NULL);
Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testfinexit", TestfinexitObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL);
Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd,
@@ -7082,6 +7085,48 @@ TestconcatobjCmd(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TestparseargsCmd --
+ *
+ * This procedure implements the "testparseargs" command. It is used to
+ * test that Tcl_ParseArgsObjv does indeed return the right number of
+ * arguments. In other words, that [Bug 3413857] was fixed properly.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestparseargsCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Arguments. */
+{
+ int count = objc, foo = 0;
+ Tcl_Obj **remObjv, *result[3];
+ Tcl_ArgvInfo argTable[] = {
+ {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL},
+ TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
+ };
+
+ if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) {
+ return TCL_ERROR;
+ }
+ result[0] = Tcl_NewIntObj(foo);
+ result[1] = Tcl_NewIntObj(count);
+ result[2] = Tcl_NewListObj(count, remObjv);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
+ return TCL_OK;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4