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 22859a7..974112c 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.90 2005/05/14 20:46:46 das Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.91 2005/06/01 21:38:42 dgp Exp $
*/
#define TCL_TEST
@@ -309,6 +309,9 @@ static int TestparsevarnameObjCmd _ANSI_ARGS_((ClientData dummy,
static int TestregexpObjCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
+static int TestreturnObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
static void TestregexpXflags _ANSI_ARGS_((char *string,
int length, int *cflagsPtr, int *eflagsPtr));
static int TestsaveresultCmd _ANSI_ARGS_((ClientData dummy,
@@ -664,6 +667,8 @@ Tcltest_Init(interp)
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
@@ -3615,6 +3620,37 @@ TestregexpXflags(string, length, cflagsPtr, eflagsPtr)
/*
*----------------------------------------------------------------------
*
+ * TestreturnObjCmd --
+ *
+ * This procedure implements the "testreturn" command. It is
+ * used to verify that a
+ * return TCL_RETURN;
+ * has same behavior as
+ * return Tcl_SetReturnOptions(interp, Tcl_NewObj());
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestreturnObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ return TCL_RETURN;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestsetassocdataCmd --
*
* This procedure implements the "testsetassocdata" command. It is used