summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c38
1 files changed, 37 insertions, 1 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 8f6bb74..bc0492f 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,7 +14,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.110.2.1 2007/06/27 22:44:48 dgp Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.110.2.2 2007/11/05 14:20:54 dgp Exp $
*/
#define TCL_TEST
@@ -343,6 +343,8 @@ static int TestsetassocdataCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
static int TestsetCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
+static int Testset2Cmd(ClientData dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
static int TestseterrorcodeCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
static int TestsetobjerrorcodeCmd(
@@ -666,6 +668,8 @@ Tcltest_Init(
(ClientData) 0, NULL);
Tcl_CreateCommand(interp, "testseterr", TestsetCmd,
(ClientData) TCL_LEAVE_ERR_MSG, NULL);
+ Tcl_CreateCommand(interp, "testset2", Testset2Cmd,
+ (ClientData) TCL_LEAVE_ERR_MSG, NULL);
Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd,
(ClientData) 0, NULL);
Tcl_CreateObjCommand(interp, "testsetobjerrorcode",
@@ -4812,6 +4816,38 @@ TestsetCmd(
return TCL_ERROR;
}
}
+static int
+Testset2Cmd(
+ ClientData data, /* Additional flags for Get/SetVar2. */
+ register Tcl_Interp *interp,/* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
+{
+ int flags = PTR2INT(data);
+ const char *value;
+
+ if (argc == 3) {
+ Tcl_SetResult(interp, "before get", TCL_STATIC);
+ value = Tcl_GetVar2(interp, argv[1], argv[2], flags);
+ if (value == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendElement(interp, value);
+ return TCL_OK;
+ } else if (argc == 4) {
+ Tcl_SetResult(interp, "before set", TCL_STATIC);
+ value = Tcl_SetVar2(interp, argv[1], argv[2], argv[3], flags);
+ if (value == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendElement(interp, value);
+ return TCL_OK;
+ } else {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " varName elemName ?newValue?\"", NULL);
+ return TCL_ERROR;
+ }
+}
/*
*----------------------------------------------------------------------