diff options
Diffstat (limited to 'generic/tclTest.c')
| -rw-r--r-- | generic/tclTest.c | 38 |
1 files changed, 37 insertions, 1 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index e7be33f..7785cc3 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.111 2007/06/27 18:21:52 dgp Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.112 2007/11/03 01:47:13 msofer 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; + } +} /* *---------------------------------------------------------------------- |