diff options
author | stanton <stanton@noemail.net> | 1998-06-18 18:25:38 (GMT) |
---|---|---|
committer | stanton <stanton@noemail.net> | 1998-06-18 18:25:38 (GMT) |
commit | 8d595cb6fc088c470045841bb1af7d1aa9f85292 (patch) | |
tree | 48d10c6b96c7ec94bb1f1d9a1332bde8b256acdf /generic | |
parent | de63d3d4408bdb28a54eb739afc4e6c49dabea17 (diff) | |
download | tcl-8d595cb6fc088c470045841bb1af7d1aa9f85292.zip tcl-8d595cb6fc088c470045841bb1af7d1aa9f85292.tar.gz tcl-8d595cb6fc088c470045841bb1af7d1aa9f85292.tar.bz2 |
fixed behavior of "array set" on initialization with an emtpy list
removed memory leak
FossilOrigin-Name: 78dd62836265b1b4d55c3cba0811dc7200533cc9
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclVar.c | 90 |
1 files changed, 57 insertions, 33 deletions
diff --git a/generic/tclVar.c b/generic/tclVar.c index f013e65..6725568 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -2799,9 +2799,18 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { + /* + * The list of constants below should match the arrayOptions string array + * below. + */ + + enum {ARRAY_ANYMORE, ARRAY_DONESEARCH, ARRAY_EXISTS, ARRAY_GET, + ARRAY_NAMES, ARRAY_NEXTELEMENT, ARRAY_SET, ARRAY_SIZE, + ARRAY_STARTSEARCH}; static char *arrayOptions[] = {"anymore", "donesearch", "exists", "get", "names", "nextelement", "set", "size", "startsearch", (char *) NULL}; + Var *varPtr, *arrayPtr; Tcl_HashEntry *hPtr; Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); @@ -2836,7 +2845,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) } switch (index) { - case 0: { /* anymore */ + case ARRAY_ANYMORE: { ArraySearch *searchPtr; char *searchId; @@ -2871,7 +2880,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) Tcl_SetIntObj(resultPtr, 1); break; } - case 1: { /* donesearch */ + case ARRAY_DONESEARCH: { ArraySearch *searchPtr, *prevPtr; char *searchId; @@ -2902,7 +2911,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) ckfree((char *) searchPtr); break; } - case 2: { /* exists */ + case ARRAY_EXISTS: { if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName"); return TCL_ERROR; @@ -2910,7 +2919,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) Tcl_SetIntObj(resultPtr, !notArray); break; } - case 3: { /*get*/ + case ARRAY_GET: { Tcl_HashSearch search; Var *varPtr2; char *pattern = NULL; @@ -2961,7 +2970,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) } break; } - case 4: { /* names */ + case ARRAY_NAMES: { Tcl_HashSearch search; Var *varPtr2; char *pattern = NULL; @@ -2998,7 +3007,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) } break; } - case 5: { /*nextelement*/ + case ARRAY_NEXTELEMENT: { ArraySearch *searchPtr; char *searchId; Tcl_HashEntry *hPtr; @@ -3037,7 +3046,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), -1); break; } - case 6: { /*set*/ + case ARRAY_SET: { Tcl_Obj **elemPtrs; int listLen, i, result; @@ -3064,34 +3073,49 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) break; } } - } else if (varPtr == NULL) { + return result; + } + + /* + * The list is empty make sure we have an array, or create + * one if necessary. + */ + + if (varPtr != NULL) { + if (!TclIsVarUndefined(varPtr) && TclIsVarArray(varPtr)) { + /* + * Already an array, done. + */ + + return TCL_OK; + } + if (TclIsVarArrayElement(varPtr) || + !TclIsVarUndefined(varPtr)) { + /* + * Either an array element, or a scalar: lose! + */ + + VarErrMsg(interp, varName, (char *)NULL, "array set", + needArray); + return TCL_ERROR; + } + } else { /* - * The list is empty and the array variable doesn't - * exist yet: create the variable with an empty array - * as the value. + * Create variable for new array. */ - - Tcl_Obj *namePtr, *valuePtr; - - namePtr = Tcl_NewStringObj("tempElem", -1); - valuePtr = Tcl_NewObj(); - if (Tcl_ObjSetVar2(interp, objv[2], namePtr, valuePtr, - /* flags*/ 0) == NULL) { - Tcl_DecrRefCount(namePtr); - Tcl_DecrRefCount(valuePtr); - return TCL_ERROR; - } - result = Tcl_UnsetVar2(interp, varName, "tempElem", - TCL_LEAVE_ERR_MSG); - if (result != TCL_OK) { - Tcl_DecrRefCount(namePtr); - Tcl_DecrRefCount(valuePtr); - return result; - } + + varPtr = TclLookupVar(interp, varName, (char *) NULL, 0, 0, + /*createPart1*/ 1, /*createPart2*/ 0, + &arrayPtr); } - return result; + TclSetVarArray(varPtr); + TclClearVarUndefined(varPtr); + varPtr->value.tablePtr = + (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS); + return TCL_OK; } - case 7: { /*size*/ + case ARRAY_SIZE: { Tcl_HashSearch search; Var *varPtr2; int size; @@ -3115,7 +3139,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) Tcl_SetIntObj(resultPtr, size); break; } - case 8: { /*startsearch*/ + case ARRAY_STARTSEARCH: { ArraySearch *searchPtr; if (objc != 3) { @@ -3259,7 +3283,7 @@ MakeUpvar(iPtr, framePtr, otherP1, otherP2, otherFlags, myName, myFlags) * leaving the namespace var's reference invalid. */ - if (otherPtr->nsPtr == NULL) { + if ((otherP2 ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL) { Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"", myName, "\": upvar won't create namespace variable that refers to procedure variable", (char *) NULL); |