summaryrefslogtreecommitdiffstats
path: root/generic/tclTestObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTestObj.c')
-rw-r--r--generic/tclTestObj.c102
1 files changed, 101 insertions, 1 deletions
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index c0a4275..0326208 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTestObj.c,v 1.21.2.1 2009/03/30 17:47:30 dgp Exp $
+ * RCS: @(#) $Id: tclTestObj.c,v 1.21.2.2 2010/03/18 20:38:43 dgp Exp $
*/
#include "tclInt.h"
@@ -48,6 +48,8 @@ static int TestindexobjCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int TestintobjCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
+static int TestlistobjCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
static int TestobjCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp,
@@ -98,6 +100,8 @@ TclObjTest_Init(
(ClientData) 0, NULL);
Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd,
(ClientData) 0, NULL);
+ Tcl_CreateObjCommand(interp, "testlistobj", TestlistobjCmd,
+ (ClientData) 0, NULL);
Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, (ClientData) 0, NULL);
Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd,
(ClientData) 0, NULL);
@@ -776,6 +780,102 @@ TestintobjCmd(
}
/*
+ *-----------------------------------------------------------------------------
+ *
+ * TestlistobjCmd --
+ *
+ * This function implements the 'testlistobj' command. It is used to
+ * test a few possible corner cases in list object manipulation from
+ * C code that cannot occur at the Tcl level.
+ *
+ * Results:
+ * A standard Tcl object result.
+ *
+ * Side effects:
+ * Creates, manipulates and frees list objects.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+TestlistobjCmd(
+ ClientData clientData, /* Not used */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Number of arguments */
+ Tcl_Obj *const objv[]) /* Argument objects */
+{
+ /* Subcommands supported by this command */
+ const char* subcommands[] = {
+ "set",
+ "get",
+ "replace"
+ };
+ enum listobjCmdIndex {
+ LISTOBJ_SET,
+ LISTOBJ_GET,
+ LISTOBJ_REPLACE
+ };
+
+ const char* index; /* Argument giving the variable number */
+ int varIndex; /* Variable number converted to binary */
+ int cmdIndex; /* Ordinal number of the subcommand */
+ int first; /* First index in the list */
+ int count; /* Count of elements in a list */
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg...?");
+ return TCL_ERROR;
+ }
+ index = Tcl_GetString(objv[2]);
+ if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "command",
+ 0, &cmdIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch(cmdIndex) {
+ case LISTOBJ_SET:
+ if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
+ Tcl_SetListObj(varPtr[varIndex], objc-3, objv+3);
+ } else {
+ SetVarToObj(varIndex, Tcl_NewListObj(objc-3, objv+3));
+ }
+ Tcl_SetObjResult(interp, varPtr[varIndex]);
+ break;
+
+ case LISTOBJ_GET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
+ return TCL_ERROR;
+ }
+ if (CheckIfVarUnset(interp, varIndex)) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, varPtr[varIndex]);
+ break;
+
+ case LISTOBJ_REPLACE:
+ if (objc < 5) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "varIndex start count ?element...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[3], &first) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[4], &count) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_IsShared(varPtr[varIndex])) {
+ SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+ }
+ Tcl_ResetResult(interp);
+ return Tcl_ListObjReplace(interp, varPtr[varIndex], first, count,
+ objc-5, objv+5);
+ }
+ return TCL_OK;
+}
+
+/*
*----------------------------------------------------------------------
*
* TestobjCmd --