diff options
Diffstat (limited to 'generic/tclTestObj.c')
| -rw-r--r-- | generic/tclTestObj.c | 798 |
1 files changed, 474 insertions, 324 deletions
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 1d4e689..f36b07f 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -12,59 +12,69 @@ * * 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.16 2005/11/02 15:59:49 dkf Exp $ */ +#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, - char *string, int *indexPtr); -static void SetVarToObj(int varIndex, Tcl_Obj *objPtr); -int TclObjTest_Init(Tcl_Interp *interp); + const char *string, int *indexPtr); +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[]); + int objc, Tcl_Obj *const objv[]); static int TestbooleanobjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); -#if 0 -static int TestconvertobjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); -#endif + Tcl_Obj *const objv[]); static int TestdoubleobjCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int TestindexobjCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int TestintobjCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + 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[]); + int objc, Tcl_Obj *const objv[]); static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); 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); +} + /* *---------------------------------------------------------------------- * @@ -84,32 +94,41 @@ typedef struct TestString { */ int -TclObjTest_Init(interp) - Tcl_Interp *interp; +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); -#if 0 - Tcl_CreateObjCommand(interp, "testconvertobj", TestconvertobjCmd, - (ClientData) 0, NULL); -#endif + 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); - Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, (ClientData) 0, NULL); + NULL, NULL); + Tcl_CreateObjCommand(interp, "testlistobj", TestlistobjCmd, + NULL, NULL); + Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd, - (ClientData) 0, NULL); + NULL, NULL); return TCL_OK; } @@ -132,25 +151,25 @@ TclObjTest_Init(interp) */ static int -TestbignumobjCmd( clientData, interp, objc, objv ) - ClientData clientData; /* unused */ - Tcl_Interp* interp; /* Tcl interpreter */ - int objc; /* Argument count */ - Tcl_Obj* CONST objv[]; /* Argument vector */ +TestbignumobjCmd( + ClientData clientData, /* unused */ + Tcl_Interp *interp, /* Tcl interpreter */ + 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, @@ -161,6 +180,7 @@ TestbignumobjCmd( clientData, interp, objc, objv ) if (GetVariableIndex(interp, string, &varIndex) != TCL_OK) { return TCL_ERROR; } + varPtr = GetVarPtr(interp); switch (index) { case BIGNUM_SET: @@ -192,7 +212,7 @@ TestbignumobjCmd( clientData, interp, objc, objv ) 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; @@ -201,7 +221,7 @@ TestbignumobjCmd( clientData, interp, objc, objv ) Tcl_WrongNumArgs(interp, 2, objv, "varIndex"); return TCL_ERROR; } - if (CheckIfVarUnset(interp, varIndex)) { + if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } break; @@ -211,7 +231,7 @@ TestbignumobjCmd( clientData, interp, objc, objv ) 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], @@ -230,7 +250,7 @@ TestbignumobjCmd( clientData, interp, objc, objv ) if (!Tcl_IsShared(varPtr[varIndex])) { Tcl_SetBignumObj(varPtr[varIndex], &newValue); } else { - SetVarToObj(varIndex, Tcl_NewBignumObj(&newValue)); + SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue)); } break; @@ -239,7 +259,7 @@ TestbignumobjCmd( clientData, interp, objc, objv ) 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], @@ -258,7 +278,7 @@ TestbignumobjCmd( clientData, interp, objc, objv ) if (!Tcl_IsShared(varPtr[varIndex])) { Tcl_SetBignumObj(varPtr[varIndex], &newValue); } else { - SetVarToObj(varIndex, Tcl_NewBignumObj(&newValue)); + SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue)); } } @@ -285,14 +305,15 @@ TestbignumobjCmd( clientData, interp, objc, objv ) */ static int -TestbooleanobjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +TestbooleanobjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int varIndex, boolValue; - char *index, *subCmd; + const char *index, *subCmd; + Tcl_Obj **varPtr; if (objc < 3) { wrongNumArgs: @@ -305,6 +326,8 @@ TestbooleanobjCmd(clientData, interp, objc, objv) return TCL_ERROR; } + varPtr = GetVarPtr(interp); + subCmd = Tcl_GetString(objv[1]); if (strcmp(subCmd, "set") == 0) { if (objc != 4) { @@ -325,14 +348,14 @@ TestbooleanobjCmd(clientData, interp, objc, objv) 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]); @@ -340,7 +363,7 @@ TestbooleanobjCmd(clientData, interp, objc, objv) if (objc != 3) { goto wrongNumArgs; } - if (CheckIfVarUnset(interp, varIndex)) { + if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex], @@ -350,7 +373,7 @@ TestbooleanobjCmd(clientData, interp, objc, objv) 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 { @@ -362,62 +385,6 @@ TestbooleanobjCmd(clientData, interp, objc, objv) return TCL_OK; } -#if 0 -/* - *---------------------------------------------------------------------- - * - * TestconvertobjCmd -- - * - * This function implements the "testconvertobj" command. It is used to - * test converting objects to new types. - * - * Results: - * A standard Tcl object result. - * - * Side effects: - * Converts objects to new types. - * - *---------------------------------------------------------------------- - */ - -static int -TestconvertobjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ -{ - char *subCmd; - char buf[20]; - - if (objc < 3) { - wrongNumArgs: - Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); - return TCL_ERROR; - } - - subCmd = Tcl_GetString(objv[1]); - if (strcmp(subCmd, "double") == 0) { - double d; - - if (objc != 3) { - goto wrongNumArgs; - } - if (Tcl_GetDoubleFromObj(interp, objv[2], &d) != TCL_OK) { - return TCL_ERROR; - } - sprintf(buf, "%f", d); - Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1); - } else { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "bad option \"", Tcl_GetString(objv[1]), - "\": must be double", NULL); - return TCL_ERROR; - } - return TCL_OK; -} -#endif - /* *---------------------------------------------------------------------- * @@ -438,15 +405,16 @@ TestconvertobjCmd(clientData, interp, objc, objv) */ static int -TestdoubleobjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +TestdoubleobjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int varIndex; double doubleValue; - char *index, *subCmd, *string; + const char *index, *subCmd, *string; + Tcl_Obj **varPtr; if (objc < 3) { wrongNumArgs: @@ -454,6 +422,8 @@ TestdoubleobjCmd(clientData, interp, objc, objv) return TCL_ERROR; } + varPtr = GetVarPtr(interp); + index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; @@ -480,14 +450,14 @@ TestdoubleobjCmd(clientData, interp, objc, objv) 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]); @@ -495,7 +465,7 @@ TestdoubleobjCmd(clientData, interp, objc, objv) if (objc != 3) { goto wrongNumArgs; } - if (CheckIfVarUnset(interp, varIndex)) { + if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex], @@ -503,26 +473,26 @@ TestdoubleobjCmd(clientData, interp, objc, objv) 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 { @@ -553,22 +523,22 @@ TestdoubleobjCmd(clientData, interp, objc, objv) */ static int -TestindexobjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +TestindexobjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int allowAbbrev, index, index2, setError, i, result; - CONST char **argv; - static CONST char *tablePtr[] = {"a", "b", "check", NULL}; + const char **argv; + 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; @@ -585,7 +555,7 @@ TestindexobjCmd(clientData, interp, objc, objv) } Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index); - indexRep = (struct IndexRep *) objv[1]->internalRep.otherValuePtr; + indexRep = objv[1]->internalRep.twoPtrValue.ptr1; indexRep->index = index2; result = Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index); @@ -607,7 +577,7 @@ TestindexobjCmd(clientData, interp, objc, objv) 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]); } @@ -620,18 +590,17 @@ TestindexobjCmd(clientData, interp, objc, objv) * 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.twoPtrValue.ptr1; + 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); } @@ -657,15 +626,16 @@ TestindexobjCmd(clientData, interp, objc, objv) */ static int -TestintobjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +TestintobjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int intValue, varIndex, i; long longValue; - char *index, *subCmd, *string; + const char *index, *subCmd, *string; + Tcl_Obj **varPtr; if (objc < 3) { wrongNumArgs: @@ -673,6 +643,7 @@ TestintobjCmd(clientData, interp, objc, objv) return TCL_ERROR; } + varPtr = GetVarPtr(interp); index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; @@ -700,7 +671,7 @@ TestintobjCmd(clientData, interp, objc, objv) 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 */ @@ -715,7 +686,7 @@ TestintobjCmd(clientData, interp, objc, objv) 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) { @@ -729,7 +700,7 @@ TestintobjCmd(clientData, interp, objc, objv) 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) { @@ -740,25 +711,25 @@ TestintobjCmd(clientData, interp, objc, objv) 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]); @@ -766,7 +737,7 @@ TestintobjCmd(clientData, interp, objc, objv) if (objc != 3) { goto wrongNumArgs; } - if (CheckIfVarUnset(interp, varIndex)) { + if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } string = Tcl_GetString(varPtr[varIndex]); @@ -788,7 +759,7 @@ TestintobjCmd(clientData, interp, objc, objv) 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); @@ -801,34 +772,34 @@ TestintobjCmd(clientData, interp, objc, objv) 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 { @@ -841,6 +812,104 @@ TestintobjCmd(clientData, interp, objc, objv) } /* + *----------------------------------------------------------------------------- + * + * 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 */ + 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; + } + 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(varPtr, 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, varPtr,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(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex])); + } + Tcl_ResetResult(interp); + return Tcl_ListObjReplace(interp, varPtr[varIndex], first, count, + objc-5, objv+5); + } + return TCL_OK; +} + +/* *---------------------------------------------------------------------- * * TestobjCmd -- @@ -858,15 +927,16 @@ TestintobjCmd(clientData, interp, objc, objv) */ static int -TestobjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +TestobjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + 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: @@ -874,108 +944,121 @@ TestobjCmd(clientData, interp, objc, objv) 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, "bug3598580") == 0) { + Tcl_Obj *listObjPtr, *elemObjPtr; + if (objc != 2) { + goto wrongNumArgs; + } + elemObjPtr = Tcl_NewIntObj(123); + listObjPtr = Tcl_NewListObj(1, &elemObjPtr); + /* Replace the single list element through itself, nonsense but legal. */ + Tcl_ListObjReplace(interp, listObjPtr, 0, 1, 1, &elemObjPtr); + Tcl_SetObjResult(interp, listObjPtr); + return TCL_OK; + } 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; + } + if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } - typeName = Tcl_GetString(objv[3]); - if ((targetType = Tcl_GetObjType(typeName)) == NULL) { + 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; + } + 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 ) { + 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) { - char *typeName; + 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 { @@ -983,41 +1066,38 @@ TestobjCmd(clientData, interp, objc, objv) 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; + } + if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } - TclFormatInt(buf, varPtr[varIndex]->refCount); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + 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; @@ -1025,7 +1105,7 @@ TestobjCmd(clientData, interp, objc, objv) } else { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad option \"", Tcl_GetString(objv[1]), - "\": must be assign, convert, duplicate, freeallvars, ", + "\": must be assign, convert, duplicate, freeallvars, " "newobj, objcount, objtype, refcount, type, or types", NULL); return TCL_ERROR; } @@ -1051,19 +1131,22 @@ TestobjCmd(clientData, interp, objc, objv) */ static int -TeststringobjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +TeststringobjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { + 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", NULL + "set", "set2", "setlength", "maxchars", "getunicode", + "appendself", "appendself2", NULL }; if (objc < 3) { @@ -1072,6 +1155,7 @@ TeststringobjCmd(clientData, interp, objc, objv) return TCL_ERROR; } + varPtr = GetVarPtr(interp); index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; @@ -1090,7 +1174,7 @@ TeststringobjCmd(clientData, interp, objc, objv) return TCL_ERROR; } if (varPtr[varIndex] == NULL) { - SetVarToObj(varIndex, Tcl_NewObj()); + SetVarToObj(varPtr, varIndex, Tcl_NewObj()); } /* @@ -1099,7 +1183,7 @@ TeststringobjCmd(clientData, interp, objc, objv) */ 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); @@ -1110,7 +1194,7 @@ TeststringobjCmd(clientData, interp, objc, objv) goto wrongNumArgs; } if (varPtr[varIndex] == NULL) { - SetVarToObj(varIndex, Tcl_NewObj()); + SetVarToObj(varPtr, varIndex, Tcl_NewObj()); } /* @@ -1119,7 +1203,7 @@ TeststringobjCmd(clientData, interp, objc, objv) */ 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]); @@ -1137,7 +1221,7 @@ TeststringobjCmd(clientData, interp, objc, objv) if (objc != 3) { goto wrongNumArgs; } - if (CheckIfVarUnset(interp, varIndex)) { + if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } Tcl_SetObjResult(interp, varPtr[varIndex]); @@ -1146,7 +1230,7 @@ TeststringobjCmd(clientData, interp, objc, objv) if (objc != 3) { goto wrongNumArgs; } - if (CheckIfVarUnset(interp, varIndex)) { + if (CheckIfVarUnset(interp, varPtr, varIndex)) { return TCL_ERROR; } string = Tcl_GetString(varPtr[varIndex]); @@ -1164,8 +1248,9 @@ TeststringobjCmd(clientData, interp, objc, objv) goto wrongNumArgs; } if (varPtr[varIndex] != NULL) { - strPtr = (TestString *) - (varPtr[varIndex])->internalRep.otherValuePtr; + Tcl_ConvertToType(NULL, varPtr[varIndex], + Tcl_GetObjType("string")); + strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1; length = (int) strPtr->allocated; } else { length = -1; @@ -1191,7 +1276,7 @@ TeststringobjCmd(clientData, interp, objc, objv) && !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; @@ -1199,7 +1284,7 @@ TeststringobjCmd(clientData, interp, objc, objv) if (objc != 4) { goto wrongNumArgs; } - SetVarToObj(varIndex, objv[3]); + SetVarToObj(varPtr, varIndex, objv[3]); break; case 8: /* setlength */ if (objc != 4) { @@ -1212,14 +1297,15 @@ TeststringobjCmd(clientData, interp, objc, objv) 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.twoPtrValue.ptr1; + length = strPtr->maxChars; } else { length = -1; } @@ -1231,6 +1317,68 @@ TeststringobjCmd(clientData, interp, objc, objv) } Tcl_GetUnicodeFromObj(varPtr[varIndex], NULL); break; + case 11: /* appendself */ + if (objc != 4) { + goto wrongNumArgs; + } + if (varPtr[varIndex] == NULL) { + SetVarToObj(varPtr, varIndex, Tcl_NewObj()); + } + + /* + * If the object bound to variable "varIndex" is shared, we must + * "copy on write" and append to a copy of the object. + */ + + if (Tcl_IsShared(varPtr[varIndex])) { + SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex])); + } + + string = Tcl_GetStringFromObj(varPtr[varIndex], &length); + + if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) { + return TCL_ERROR; + } + if ((i < 0) || (i > length)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "index value out of range", -1)); + return TCL_ERROR; + } + + Tcl_AppendToObj(varPtr[varIndex], string + i, length - i); + Tcl_SetObjResult(interp, varPtr[varIndex]); + break; + case 12: /* appendself2 */ + if (objc != 4) { + goto wrongNumArgs; + } + if (varPtr[varIndex] == NULL) { + SetVarToObj(varPtr, varIndex, Tcl_NewObj()); + } + + /* + * If the object bound to variable "varIndex" is shared, we must + * "copy on write" and append to a copy of the object. + */ + + if (Tcl_IsShared(varPtr[varIndex])) { + SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex])); + } + + unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &length); + + if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) { + return TCL_ERROR; + } + if ((i < 0) || (i > length)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "index value out of range", -1)); + return TCL_ERROR; + } + + Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + i, length - i); + Tcl_SetObjResult(interp, varPtr[varIndex]); + break; } return TCL_OK; @@ -1256,9 +1404,10 @@ TeststringobjCmd(clientData, interp, objc, objv) */ static void -SetVarToObj(varIndex, objPtr) - int varIndex; /* Designates the assignment variable. */ - Tcl_Obj *objPtr; /* Points to object to assign to var. */ +SetVarToObj( + Tcl_Obj **varPtr, + int varIndex, /* Designates the assignment variable. */ + Tcl_Obj *objPtr) /* Points to object to assign to var. */ { if (varPtr[varIndex] != NULL) { Tcl_DecrRefCount(varPtr[varIndex]); @@ -1286,12 +1435,12 @@ SetVarToObj(varIndex, objPtr) */ static int -GetVariableIndex(interp, string, indexPtr) - Tcl_Interp *interp; /* Interpreter for error reporting. */ - char *string; /* String containing a variable index - * specified as a nonnegative number less - * than NUMBER_OF_OBJECT_VARS. */ - int *indexPtr; /* Place to store converted result. */ +GetVariableIndex( + Tcl_Interp *interp, /* Interpreter for error reporting. */ + const char *string, /* String containing a variable index + * specified as a nonnegative number less than + * NUMBER_OF_OBJECT_VARS. */ + int *indexPtr) /* Place to store converted result. */ { int index; @@ -1327,9 +1476,10 @@ GetVariableIndex(interp, string, indexPtr) */ static int -CheckIfVarUnset(interp, varIndex) - Tcl_Interp *interp; /* Interpreter for error reporting. */ - int varIndex; /* Index of the test variable to check. */ +CheckIfVarUnset( + Tcl_Interp *interp, /* Interpreter for error reporting. */ + Tcl_Obj ** varPtr, + int varIndex) /* Index of the test variable to check. */ { if (varPtr[varIndex] == NULL) { char buf[32 + TCL_INTEGER_SPACE]; |