summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
authorstanton <stanton>1999-02-03 00:55:04 (GMT)
committerstanton <stanton>1999-02-03 00:55:04 (GMT)
commite0ef1543276028c3f855c5e12b53551fc20fdebf (patch)
tree54aa9c12b6ea7911adec5a90deda722113ae9043 /generic/tclTest.c
parentd302d0e71085efc1f3c7d150e571cd9bb1901600 (diff)
downloadtcl-e0ef1543276028c3f855c5e12b53551fc20fdebf.zip
tcl-e0ef1543276028c3f855c5e12b53551fc20fdebf.tar.gz
tcl-e0ef1543276028c3f855c5e12b53551fc20fdebf.tar.bz2
* generic/tclProc.c:
* generic/tclNamesp.c: * generic/tclInt.h: * generic/tclCmdIL.c: * generic/tclBasic.c: * generic/tclVar.c: Applied patch from Viktor Dukhovni to rationalize TCL_LEAVE_ERR_MSG behavior when creating variables. * generic/tclVar.c: Fixed bug in namespace tail computation. Fixed bug where upvar could resurrect a namespace variable whose namespace had been deleted. * generic/tclCompile.c (TclCompileExprCmd): Eliminated yet another bogus optimization in expression compilation. * generic/tclCompile.c (CompileExprWord): Fixed exception stack overflow bug caused by missing statement. [Bug: 928] * generic/tclIOCmd.c: * generic/tclBasic.c: Objectified the "open" command. [Bug: 1113]
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c60
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 \"",