summaryrefslogtreecommitdiffstats
path: root/generic/tclTestObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTestObj.c')
-rw-r--r--generic/tclTestObj.c454
1 files changed, 248 insertions, 206 deletions
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 37286e3..7494beb 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -14,27 +14,21 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#ifndef USE_TCL_STUBS
+# define USE_TCL_STUBS
+#endif
#include "tclInt.h"
#include "tommath.h"
-/*
- * An array of Tcl_Obj pointers used in the commands that operate on or get
- * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's
- * Tcl_Obj *.
- */
-
-#define NUMBER_OF_OBJECT_VARS 20
-static Tcl_Obj *varPtr[NUMBER_OF_OBJECT_VARS];
/*
* Forward declarations for functions defined later in this file:
*/
-static int CheckIfVarUnset(Tcl_Interp *interp, int varIndex);
+static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, int varIndex);
static int GetVariableIndex(Tcl_Interp *interp,
const char *string, int *indexPtr);
-static void SetVarToObj(int varIndex, Tcl_Obj *objPtr);
-int TclObjTest_Init(Tcl_Interp *interp);
+static void SetVarToObj(Tcl_Obj **varPtr, int varIndex, Tcl_Obj *objPtr);
static int TestbignumobjCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int TestbooleanobjCmd(ClientData dummy,
@@ -55,11 +49,32 @@ static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp,
typedef struct TestString {
int numChars;
- size_t allocated;
- size_t uallocated;
+ int allocated;
+ int maxChars;
Tcl_UniChar unicode[2];
} TestString;
+#define VARPTR_KEY "TCLOBJTEST_VARPTR"
+#define NUMBER_OF_OBJECT_VARS 20
+
+static void VarPtrDeleteProc(ClientData clientData, Tcl_Interp *interp)
+{
+ register int i;
+ Tcl_Obj **varPtr = (Tcl_Obj **) clientData;
+ for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
+ if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]);
+ }
+ Tcl_DeleteAssocData(interp, VARPTR_KEY);
+ ckfree(varPtr);
+}
+
+static Tcl_Obj **GetVarPtr(Tcl_Interp *interp)
+{
+ Tcl_InterpDeleteProc *proc;
+
+ return (Tcl_Obj **) Tcl_GetAssocData(interp, VARPTR_KEY, &proc);
+}
+
/*
*----------------------------------------------------------------------
*
@@ -83,26 +98,37 @@ TclObjTest_Init(
Tcl_Interp *interp)
{
register int i;
+ /*
+ * An array of Tcl_Obj pointers used in the commands that operate on or get
+ * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's
+ * Tcl_Obj *.
+ */
+ Tcl_Obj **varPtr;
+ varPtr = (Tcl_Obj **) ckalloc(NUMBER_OF_OBJECT_VARS *sizeof(varPtr[0]));
+ if (!varPtr) {
+ return TCL_ERROR;
+ }
+ Tcl_SetAssocData(interp, VARPTR_KEY, VarPtrDeleteProc, varPtr);
for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
- varPtr[i] = NULL;
+ varPtr[i] = NULL;
}
Tcl_CreateObjCommand(interp, "testbignumobj", TestbignumobjCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testbooleanobj", TestbooleanobjCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testdoubleobj", TestdoubleobjCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testintobj", TestintobjCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testlistobj", TestlistobjCmd,
- (ClientData) 0, NULL);
- Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, (ClientData) 0, NULL);
+ NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
return TCL_OK;
}
@@ -131,19 +157,19 @@ TestbignumobjCmd(
int objc, /* Argument count */
Tcl_Obj *const objv[]) /* Argument vector */
{
- const char * subcmds[] = {
- "set", "get", "mult10", "div10", NULL
+ const char *const subcmds[] = {
+ "set", "get", "mult10", "div10", NULL
};
enum options {
- BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10
+ BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10
};
-
int index, varIndex;
- char* string;
+ const char *string;
mp_int bignumValue, newValue;
+ Tcl_Obj **varPtr;
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?...");
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
@@ -154,6 +180,7 @@ TestbignumobjCmd(
if (GetVariableIndex(interp, string, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
switch (index) {
case BIGNUM_SET:
@@ -185,7 +212,7 @@ TestbignumobjCmd(
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetBignumObj(varPtr[varIndex], &bignumValue);
} else {
- SetVarToObj(varIndex, Tcl_NewBignumObj(&bignumValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue));
}
break;
@@ -194,7 +221,7 @@ TestbignumobjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
return TCL_ERROR;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
break;
@@ -204,7 +231,7 @@ TestbignumobjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
return TCL_ERROR;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
@@ -223,7 +250,7 @@ TestbignumobjCmd(
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetBignumObj(varPtr[varIndex], &newValue);
} else {
- SetVarToObj(varIndex, Tcl_NewBignumObj(&newValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue));
}
break;
@@ -232,7 +259,7 @@ TestbignumobjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
return TCL_ERROR;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
@@ -251,7 +278,7 @@ TestbignumobjCmd(
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetBignumObj(varPtr[varIndex], &newValue);
} else {
- SetVarToObj(varIndex, Tcl_NewBignumObj(&newValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue));
}
}
@@ -285,7 +312,8 @@ TestbooleanobjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
int varIndex, boolValue;
- char *index, *subCmd;
+ const char *index, *subCmd;
+ Tcl_Obj **varPtr;
if (objc < 3) {
wrongNumArgs:
@@ -298,6 +326,8 @@ TestbooleanobjCmd(
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
+
subCmd = Tcl_GetString(objv[1]);
if (strcmp(subCmd, "set") == 0) {
if (objc != 4) {
@@ -318,14 +348,14 @@ TestbooleanobjCmd(
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
} else {
- SetVarToObj(varIndex, Tcl_NewBooleanObj(boolValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(boolValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "get") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -333,7 +363,7 @@ TestbooleanobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
@@ -343,7 +373,7 @@ TestbooleanobjCmd(
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
} else {
- SetVarToObj(varIndex, Tcl_NewBooleanObj(!boolValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(!boolValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
@@ -383,7 +413,8 @@ TestdoubleobjCmd(
{
int varIndex;
double doubleValue;
- char *index, *subCmd, *string;
+ const char *index, *subCmd, *string;
+ Tcl_Obj **varPtr;
if (objc < 3) {
wrongNumArgs:
@@ -391,6 +422,8 @@ TestdoubleobjCmd(
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
+
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
@@ -417,14 +450,14 @@ TestdoubleobjCmd(
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetDoubleObj(varPtr[varIndex], doubleValue);
} else {
- SetVarToObj(varIndex, Tcl_NewDoubleObj(doubleValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "get") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -432,7 +465,7 @@ TestdoubleobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
@@ -440,26 +473,26 @@ TestdoubleobjCmd(
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetDoubleObj(varPtr[varIndex], (doubleValue * 10.0));
+ Tcl_SetDoubleObj(varPtr[varIndex], doubleValue * 10.0);
} else {
- SetVarToObj(varIndex, Tcl_NewDoubleObj( (doubleValue * 10.0) ));
+ SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue * 10.0));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "div10") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
- &doubleValue) != TCL_OK) {
+ &doubleValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetDoubleObj(varPtr[varIndex], (doubleValue / 10.0));
+ Tcl_SetDoubleObj(varPtr[varIndex], doubleValue / 10.0);
} else {
- SetVarToObj(varIndex, Tcl_NewDoubleObj( (doubleValue / 10.0) ));
+ SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue / 10.0));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
@@ -498,14 +531,14 @@ TestindexobjCmd(
{
int allowAbbrev, index, index2, setError, i, result;
const char **argv;
- static const char *tablePtr[] = {"a", "b", "check", NULL};
+ static const char *const tablePtr[] = {"a", "b", "check", NULL};
/*
* Keep this structure declaration in sync with tclIndexObj.c
*/
struct IndexRep {
- VOID *tablePtr; /* Pointer to the table of strings */
- int offset; /* Offset between table entries */
- int index; /* Selected index into table. */
+ void *tablePtr; /* Pointer to the table of strings. */
+ int offset; /* Offset between table entries. */
+ int index; /* Selected index into table. */
};
struct IndexRep *indexRep;
@@ -522,7 +555,7 @@ TestindexobjCmd(
}
Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
- indexRep = (struct IndexRep *) objv[1]->internalRep.otherValuePtr;
+ indexRep = objv[1]->internalRep.otherValuePtr;
indexRep->index = index2;
result = Tcl_GetIndexFromObj(NULL, objv[1],
tablePtr, "token", 0, &index);
@@ -544,7 +577,7 @@ TestindexobjCmd(
return TCL_ERROR;
}
- argv = (const char **) ckalloc((unsigned) ((objc-3) * sizeof(char *)));
+ argv = ckalloc((objc-3) * sizeof(char *));
for (i = 4; i < objc; i++) {
argv[i-4] = Tcl_GetString(objv[i]);
}
@@ -557,18 +590,17 @@ TestindexobjCmd(
* object, clear out the object's cached state.
*/
- if ( objv[3]->typePtr != NULL
- && !strcmp( "index", objv[3]->typePtr->name ) ) {
- indexRep = (struct IndexRep *) objv[3]->internalRep.otherValuePtr;
- if (indexRep->tablePtr == (VOID *) argv) {
- objv[3]->typePtr->freeIntRepProc(objv[3]);
- objv[3]->typePtr = NULL;
+ if (objv[3]->typePtr != NULL
+ && !strcmp("index", objv[3]->typePtr->name)) {
+ indexRep = objv[3]->internalRep.otherValuePtr;
+ if (indexRep->tablePtr == (void *) argv) {
+ TclFreeIntRep(objv[3]);
}
}
result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
argv, "token", (allowAbbrev? 0 : TCL_EXACT), &index);
- ckfree((char *) argv);
+ ckfree(argv);
if (result == TCL_OK) {
Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
}
@@ -602,7 +634,8 @@ TestintobjCmd(
{
int intValue, varIndex, i;
long longValue;
- char *index, *subCmd, *string;
+ const char *index, *subCmd, *string;
+ Tcl_Obj **varPtr;
if (objc < 3) {
wrongNumArgs:
@@ -610,6 +643,7 @@ TestintobjCmd(
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
@@ -637,7 +671,7 @@ TestintobjCmd(
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetIntObj(varPtr[varIndex], intValue);
} else {
- SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "set2") == 0) { /* doesn't set result */
@@ -652,7 +686,7 @@ TestintobjCmd(
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetIntObj(varPtr[varIndex], intValue);
} else {
- SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
}
} else if (strcmp(subCmd, "setlong") == 0) {
if (objc != 4) {
@@ -666,7 +700,7 @@ TestintobjCmd(
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetLongObj(varPtr[varIndex], intValue);
} else {
- SetVarToObj(varIndex, Tcl_NewLongObj(intValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "setmaxlong") == 0) {
@@ -677,25 +711,25 @@ TestintobjCmd(
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetLongObj(varPtr[varIndex], maxLong);
} else {
- SetVarToObj(varIndex, Tcl_NewLongObj(maxLong));
+ SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(maxLong));
}
} else if (strcmp(subCmd, "ismaxlong") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetLongFromObj(interp, varPtr[varIndex], &longValue) != TCL_OK) {
return TCL_ERROR;
}
Tcl_AppendToObj(Tcl_GetObjResult(interp),
- ((longValue == LONG_MAX)? "1" : "0"), -1);
+ ((longValue == LONG_MAX)? "1" : "0"), -1);
} else if (strcmp(subCmd, "get") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -703,7 +737,7 @@ TestintobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
string = Tcl_GetString(varPtr[varIndex]);
@@ -725,7 +759,7 @@ TestintobjCmd(
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetLongObj(varPtr[varIndex], LONG_MAX);
} else {
- SetVarToObj(varIndex, Tcl_NewLongObj(LONG_MAX));
+ SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(LONG_MAX));
}
if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) {
Tcl_ResetResult(interp);
@@ -738,34 +772,34 @@ TestintobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
- &intValue) != TCL_OK) {
+ &intValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetIntObj(varPtr[varIndex], (intValue * 10));
+ Tcl_SetIntObj(varPtr[varIndex], intValue * 10);
} else {
- SetVarToObj(varIndex, Tcl_NewIntObj( (intValue * 10) ));
+ SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue * 10));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "div10") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
- &intValue) != TCL_OK) {
+ &intValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetIntObj(varPtr[varIndex], (intValue / 10));
+ Tcl_SetIntObj(varPtr[varIndex], intValue / 10);
} else {
- SetVarToObj(varIndex, Tcl_NewIntObj( (intValue / 10) ));
+ SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue / 10));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
@@ -819,11 +853,13 @@ TestlistobjCmd(
int cmdIndex; /* Ordinal number of the subcommand */
int first; /* First index in the list */
int count; /* Count of elements in a list */
+ Tcl_Obj **varPtr;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg...?");
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
@@ -837,7 +873,7 @@ TestlistobjCmd(
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));
+ SetVarToObj(varPtr, varIndex, Tcl_NewListObj(objc-3, objv+3));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
@@ -847,7 +883,7 @@ TestlistobjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
return TCL_ERROR;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -864,7 +900,7 @@ TestlistobjCmd(
return TCL_ERROR;
}
if (Tcl_IsShared(varPtr[varIndex])) {
- SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+ SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
Tcl_ResetResult(interp);
return Tcl_ListObjReplace(interp, varPtr[varIndex], first, count,
@@ -898,8 +934,9 @@ TestobjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
int varIndex, destIndex, i;
- char *index, *subCmd, *string;
- Tcl_ObjType *targetType;
+ const char *index, *subCmd, *string;
+ const Tcl_ObjType *targetType;
+ Tcl_Obj **varPtr;
if (objc < 2) {
wrongNumArgs:
@@ -907,108 +944,110 @@ TestobjCmd(
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
subCmd = Tcl_GetString(objv[1]);
if (strcmp(subCmd, "assign") == 0) {
- if (objc != 4) {
- goto wrongNumArgs;
- }
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
- return TCL_ERROR;
- }
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (objc != 4) {
+ goto wrongNumArgs;
+ }
+ index = Tcl_GetString(objv[2]);
+ if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
string = Tcl_GetString(objv[3]);
- if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
- return TCL_ERROR;
- }
- SetVarToObj(destIndex, varPtr[varIndex]);
+ if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ SetVarToObj(varPtr, destIndex, varPtr[varIndex]);
Tcl_SetObjResult(interp, varPtr[destIndex]);
- } else if (strcmp(subCmd, "convert") == 0) {
- char *typeName;
- if (objc != 4) {
- goto wrongNumArgs;
- }
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
- return TCL_ERROR;
- }
- if (CheckIfVarUnset(interp, varIndex)) {
+ } else if (strcmp(subCmd, "convert") == 0) {
+ const char *typeName;
+
+ if (objc != 4) {
+ goto wrongNumArgs;
+ }
+ index = Tcl_GetString(objv[2]);
+ if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
- typeName = Tcl_GetString(objv[3]);
- if ((targetType = Tcl_GetObjType(typeName)) == NULL) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+ return TCL_ERROR;
+ }
+ typeName = Tcl_GetString(objv[3]);
+ if ((targetType = Tcl_GetObjType(typeName)) == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"no type ", typeName, " found", NULL);
- return TCL_ERROR;
- }
- if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType)
- != TCL_OK) {
- return TCL_ERROR;
- }
+ return TCL_ERROR;
+ }
+ if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "duplicate") == 0) {
- if (objc != 4) {
- goto wrongNumArgs;
- }
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
- return TCL_ERROR;
- }
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (objc != 4) {
+ goto wrongNumArgs;
+ }
+ index = Tcl_GetString(objv[2]);
+ if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
string = Tcl_GetString(objv[3]);
- if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
- return TCL_ERROR;
- }
- SetVarToObj(destIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+ if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ SetVarToObj(varPtr, destIndex, Tcl_DuplicateObj(varPtr[varIndex]));
Tcl_SetObjResult(interp, varPtr[destIndex]);
} else if (strcmp(subCmd, "freeallvars") == 0) {
- if (objc != 2) {
- goto wrongNumArgs;
- }
- for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
- if (varPtr[i] != NULL) {
- Tcl_DecrRefCount(varPtr[i]);
- varPtr[i] = NULL;
- }
- }
- } else if ( strcmp ( subCmd, "invalidateStringRep" ) == 0 ) {
- if ( objc != 3 ) {
+ if (objc != 2) {
goto wrongNumArgs;
}
- index = Tcl_GetString( objv[2] );
- if ( GetVariableIndex( interp, index, &varIndex ) != TCL_OK ) {
+ for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
+ if (varPtr[i] != NULL) {
+ Tcl_DecrRefCount(varPtr[i]);
+ varPtr[i] = NULL;
+ }
+ }
+ } else if (strcmp(subCmd, "invalidateStringRep") == 0) {
+ if (objc != 3) {
+ goto wrongNumArgs;
+ }
+ index = Tcl_GetString(objv[2]);
+ if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
- Tcl_InvalidateStringRep( varPtr[varIndex] );
- Tcl_SetObjResult( interp, varPtr[varIndex] );
+ Tcl_InvalidateStringRep(varPtr[varIndex]);
+ Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "newobj") == 0) {
- if (objc != 3) {
- goto wrongNumArgs;
- }
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
- return TCL_ERROR;
- }
- SetVarToObj(varIndex, Tcl_NewObj());
+ if (objc != 3) {
+ goto wrongNumArgs;
+ }
+ index = Tcl_GetString(objv[2]);
+ if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ SetVarToObj(varPtr, varIndex, Tcl_NewObj());
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "objtype") == 0) {
const char *typeName;
/*
- * return an object containing the name of the argument's type
- * of internal rep. If none exists, return "none".
+ * Return an object containing the name of the argument's type of
+ * internal rep. If none exists, return "none".
*/
- if (objc != 3) {
- goto wrongNumArgs;
- }
+ if (objc != 3) {
+ goto wrongNumArgs;
+ }
if (objv[2]->typePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));
} else {
@@ -1016,41 +1055,38 @@ TestobjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
}
} else if (strcmp(subCmd, "refcount") == 0) {
- char buf[TCL_INTEGER_SPACE];
-
- if (objc != 3) {
- goto wrongNumArgs;
- }
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
- return TCL_ERROR;
- }
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (objc != 3) {
+ goto wrongNumArgs;
+ }
+ index = Tcl_GetString(objv[2]);
+ if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
- TclFormatInt(buf, varPtr[varIndex]->refCount);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(varPtr[varIndex]->refCount));
} else if (strcmp(subCmd, "type") == 0) {
- if (objc != 3) {
- goto wrongNumArgs;
- }
- index = Tcl_GetString(objv[2]);
- if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
- return TCL_ERROR;
- }
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (objc != 3) {
+ goto wrongNumArgs;
+ }
+ index = Tcl_GetString(objv[2]);
+ if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
- if (varPtr[varIndex]->typePtr == NULL) { /* a string! */
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+ return TCL_ERROR;
+ }
+ if (varPtr[varIndex]->typePtr == NULL) { /* a string! */
Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", -1);
- } else {
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- varPtr[varIndex]->typePtr->name, -1);
- }
+ } else {
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ varPtr[varIndex]->typePtr->name, -1);
+ }
} else if (strcmp(subCmd, "types") == 0) {
- if (objc != 2) {
- goto wrongNumArgs;
- }
+ if (objc != 2) {
+ goto wrongNumArgs;
+ }
if (Tcl_AppendAllObjTypes(interp,
Tcl_GetObjResult(interp)) != TCL_OK) {
return TCL_ERROR;
@@ -1090,14 +1126,15 @@ TeststringobjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int varIndex, option, i, length;
Tcl_UniChar *unicode;
+ int varIndex, option, i, length;
#define MAX_STRINGS 11
- char *index, *string, *strings[MAX_STRINGS+1];
+ const char *index, *string, *strings[MAX_STRINGS+1];
TestString *strPtr;
- static const char *options[] = {
+ Tcl_Obj **varPtr;
+ static const char *const options[] = {
"append", "appendstrings", "get", "get2", "length", "length2",
- "set", "set2", "setlength", "ualloc", "getunicode",
+ "set", "set2", "setlength", "maxchars", "getunicode",
"appendself", "appendself2", NULL
};
@@ -1107,6 +1144,7 @@ TeststringobjCmd(
return TCL_ERROR;
}
+ varPtr = GetVarPtr(interp);
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
@@ -1125,7 +1163,7 @@ TeststringobjCmd(
return TCL_ERROR;
}
if (varPtr[varIndex] == NULL) {
- SetVarToObj(varIndex, Tcl_NewObj());
+ SetVarToObj(varPtr, varIndex, Tcl_NewObj());
}
/*
@@ -1134,7 +1172,7 @@ TeststringobjCmd(
*/
if (Tcl_IsShared(varPtr[varIndex])) {
- SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+ SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
string = Tcl_GetString(objv[3]);
Tcl_AppendToObj(varPtr[varIndex], string, length);
@@ -1145,7 +1183,7 @@ TeststringobjCmd(
goto wrongNumArgs;
}
if (varPtr[varIndex] == NULL) {
- SetVarToObj(varIndex, Tcl_NewObj());
+ SetVarToObj(varPtr, varIndex, Tcl_NewObj());
}
/*
@@ -1154,7 +1192,7 @@ TeststringobjCmd(
*/
if (Tcl_IsShared(varPtr[varIndex])) {
- SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+ SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
for (i = 3; i < objc; i++) {
strings[i-3] = Tcl_GetString(objv[i]);
@@ -1172,7 +1210,7 @@ TeststringobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -1181,7 +1219,7 @@ TeststringobjCmd(
if (objc != 3) {
goto wrongNumArgs;
}
- if (CheckIfVarUnset(interp, varIndex)) {
+ if (CheckIfVarUnset(interp, varPtr, varIndex)) {
return TCL_ERROR;
}
string = Tcl_GetString(varPtr[varIndex]);
@@ -1199,8 +1237,9 @@ TeststringobjCmd(
goto wrongNumArgs;
}
if (varPtr[varIndex] != NULL) {
- strPtr = (TestString *)
- (varPtr[varIndex])->internalRep.otherValuePtr;
+ Tcl_ConvertToType(NULL, varPtr[varIndex],
+ Tcl_GetObjType("string"));
+ strPtr = varPtr[varIndex]->internalRep.otherValuePtr;
length = (int) strPtr->allocated;
} else {
length = -1;
@@ -1226,7 +1265,7 @@ TeststringobjCmd(
&& !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetStringObj(varPtr[varIndex], string, length);
} else {
- SetVarToObj(varIndex, Tcl_NewStringObj(string, length));
+ SetVarToObj(varPtr, varIndex, Tcl_NewStringObj(string, length));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
@@ -1234,7 +1273,7 @@ TeststringobjCmd(
if (objc != 4) {
goto wrongNumArgs;
}
- SetVarToObj(varIndex, objv[3]);
+ SetVarToObj(varPtr, varIndex, objv[3]);
break;
case 8: /* setlength */
if (objc != 4) {
@@ -1247,14 +1286,15 @@ TeststringobjCmd(
Tcl_SetObjLength(varPtr[varIndex], length);
}
break;
- case 9: /* ualloc */
+ case 9: /* maxchars */
if (objc != 3) {
goto wrongNumArgs;
}
if (varPtr[varIndex] != NULL) {
- strPtr = (TestString *)
- (varPtr[varIndex])->internalRep.otherValuePtr;
- length = (int) strPtr->uallocated;
+ Tcl_ConvertToType(NULL, varPtr[varIndex],
+ Tcl_GetObjType("string"));
+ strPtr = varPtr[varIndex]->internalRep.otherValuePtr;
+ length = strPtr->maxChars;
} else {
length = -1;
}
@@ -1271,7 +1311,7 @@ TeststringobjCmd(
goto wrongNumArgs;
}
if (varPtr[varIndex] == NULL) {
- SetVarToObj(varIndex, Tcl_NewObj());
+ SetVarToObj(varPtr, varIndex, Tcl_NewObj());
}
/*
@@ -1280,7 +1320,7 @@ TeststringobjCmd(
*/
if (Tcl_IsShared(varPtr[varIndex])) {
- SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+ SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
string = Tcl_GetStringFromObj(varPtr[varIndex], &length);
@@ -1302,7 +1342,7 @@ TeststringobjCmd(
goto wrongNumArgs;
}
if (varPtr[varIndex] == NULL) {
- SetVarToObj(varIndex, Tcl_NewObj());
+ SetVarToObj(varPtr, varIndex, Tcl_NewObj());
}
/*
@@ -1311,7 +1351,7 @@ TeststringobjCmd(
*/
if (Tcl_IsShared(varPtr[varIndex])) {
- SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+ SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &length);
@@ -1354,6 +1394,7 @@ TeststringobjCmd(
static void
SetVarToObj(
+ Tcl_Obj **varPtr,
int varIndex, /* Designates the assignment variable. */
Tcl_Obj *objPtr) /* Points to object to assign to var. */
{
@@ -1426,6 +1467,7 @@ GetVariableIndex(
static int
CheckIfVarUnset(
Tcl_Interp *interp, /* Interpreter for error reporting. */
+ Tcl_Obj ** varPtr,
int varIndex) /* Index of the test variable to check. */
{
if (varPtr[varIndex] == NULL) {