diff options
Diffstat (limited to 'generic/tclTest.c')
| -rw-r--r-- | generic/tclTest.c | 60 |
1 files changed, 29 insertions, 31 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index 7454771..32b326c 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -12,7 +12,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.6 1998/11/10 06:54:33 jingham Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.7 1999/02/03 00:55:06 stanton Exp $ */ #define TCL_TEST @@ -186,8 +186,8 @@ static int TestPanicCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); static int TestsetassocdataCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); -static int TestsetnoerrCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); +static int TestsetCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int argc, char **argv)); static int TestsetobjerrorcodeCmd _ANSI_ARGS_(( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); @@ -311,8 +311,10 @@ Tcltest_Init(interp) (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateCommand(interp, "testsetnoerr", TestsetnoerrCmd, + Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand(interp, "testseterr", TestsetCmd, + (ClientData) TCL_LEAVE_ERR_MSG, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "testsetobjerrorcode", TestsetobjerrorcodeCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); @@ -2697,51 +2699,47 @@ NoopObjCmd(unused, interp, objc, objv) /* *---------------------------------------------------------------------- * - * TestsetnoerrCmd -- + * TestsetCmd -- * - * Implements the "testsetnoerr" cmd that is used when testing - * the Tcl_Set/GetVar C Api without TCL_LEAVE_ERR_MSG flag + * Implements the "testset{err,noerr}" cmds that are used when testing + * Tcl_Set/GetVar C Api with/without TCL_LEAVE_ERR_MSG flag * * Results: * A standard Tcl result. * * Side effects: - * None. + * Variables may be set. * *---------------------------------------------------------------------- */ /* ARGSUSED */ -static int -TestsetnoerrCmd(dummy, interp, argc, argv) - ClientData dummy; /* Not used. */ +TestsetCmd(data, interp, argc, argv) + ClientData data; /* Additional flags for Get/SetVar2. */ register Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ char **argv; /* Argument strings. */ { + int flags = (int) data; char *value; + if (argc == 2) { - Tcl_SetResult(interp, "before get", TCL_STATIC); - value = Tcl_GetVar2(interp, argv[1], (char *) NULL, TCL_PARSE_PART1); - if (value == NULL) { - return TCL_ERROR; - } - Tcl_SetResult(interp, value, TCL_VOLATILE); - return TCL_OK; + Tcl_SetResult(interp, "before get", TCL_STATIC); + value = Tcl_GetVar2(interp, argv[1], (char *) NULL, + TCL_PARSE_PART1|flags); + if (value == NULL) { + return TCL_ERROR; + } + Tcl_AppendElement(interp, value); + return TCL_OK; } else if (argc == 3) { - char *m1 = "before set"; - char *message=Tcl_Alloc(strlen(m1)+1); - - strcpy(message,m1); - - Tcl_SetResult(interp, message, TCL_DYNAMIC); - - value = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[2], - TCL_PARSE_PART1); - if (value == NULL) { - return TCL_ERROR; - } - Tcl_SetResult(interp, value, TCL_VOLATILE); + Tcl_SetResult(interp, "before set", TCL_STATIC); + value = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[2], + TCL_PARSE_PART1|flags); + if (value == NULL) { + return TCL_ERROR; + } + Tcl_AppendElement(interp, value); return TCL_OK; } else { Tcl_AppendResult(interp, "wrong # args: should be \"", |