diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2004-08-31 15:19:35 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2004-08-31 15:19:35 (GMT) |
commit | 9a9b0aefb8d903006586c7445a843656fe45107f (patch) | |
tree | 1bef5c1caca0c9ba498f26d4ab155eed6ac330b9 /generic/tclVar.c | |
parent | 2dff694c415bcb05ec35723e1d67c61c07d7bfaa (diff) | |
download | tcl-9a9b0aefb8d903006586c7445a843656fe45107f.zip tcl-9a9b0aefb8d903006586c7445a843656fe45107f.tar.gz tcl-9a9b0aefb8d903006586c7445a843656fe45107f.tar.bz2 |
Grammar and spelling fixes. [Patch 1018486]
Diffstat (limited to 'generic/tclVar.c')
-rw-r--r-- | generic/tclVar.c | 130 |
1 files changed, 119 insertions, 11 deletions
diff --git a/generic/tclVar.c b/generic/tclVar.c index 6c1a4e5..30bbcd6 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.88 2004/08/16 14:11:31 msofer Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.89 2004/08/31 15:19:36 dkf Exp $ */ #ifdef STDC_HEADERS @@ -2671,10 +2671,11 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) enum {ARRAY_ANYMORE, ARRAY_DONESEARCH, ARRAY_EXISTS, ARRAY_GET, ARRAY_NAMES, ARRAY_NEXTELEMENT, ARRAY_SET, ARRAY_SIZE, - ARRAY_STARTSEARCH, ARRAY_STATISTICS, ARRAY_UNSET}; + ARRAY_STARTSEARCH, ARRAY_STATISTICS, ARRAY_UNSET, ARRAY_VALUES}; static CONST char *arrayOptions[] = { "anymore", "donesearch", "exists", "get", "names", "nextelement", - "set", "size", "startsearch", "statistics", "unset", (char *) NULL + "set", "size", "startsearch", "statistics", "unset", "values", + (char *) NULL }; Interp *iPtr = (Interp *) interp; @@ -2832,7 +2833,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) * Store the array names in a new object. */ - nameLstPtr = Tcl_NewObj(); + nameLstPtr = TclNewObj(); Tcl_IncrRefCount(nameLstPtr); for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); @@ -2850,8 +2851,8 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) result = Tcl_ListObjAppendElement(interp, nameLstPtr, namePtr); if (result != TCL_OK) { - Tcl_DecrRefCount(namePtr); /* free unneeded name obj */ - Tcl_DecrRefCount(nameLstPtr); + TclDecrRefCount(namePtr); /* free unneeded name obj */ + TclDecrRefCount(nameLstPtr); return result; } } @@ -2867,7 +2868,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) * Get the array values corresponding to each element name */ - tmpResPtr = Tcl_NewObj(); + tmpResPtr = TclNewObj(); result = Tcl_ListObjGetElements(interp, nameLstPtr, &count, &namePtrPtr); if (result != TCL_OK) { @@ -2904,13 +2905,13 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) } varPtr->refCount--; Tcl_SetObjResult(interp, tmpResPtr); - Tcl_DecrRefCount(nameLstPtr); + TclDecrRefCount(nameLstPtr); break; errorInArrayGet: varPtr->refCount--; - Tcl_DecrRefCount(nameLstPtr); - Tcl_DecrRefCount(tmpResPtr); /* free unneeded temp result obj */ + TclDecrRefCount(nameLstPtr); + TclDecrRefCount(tmpResPtr); /* free unneeded temp result obj */ return result; } case ARRAY_NAMES: { @@ -2975,12 +2976,119 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) namePtr = Tcl_NewStringObj(name, -1); result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr); if (result != TCL_OK) { - Tcl_DecrRefCount(namePtr); /* free unneeded name obj */ + TclDecrRefCount(namePtr); /* free unneeded name obj */ return result; } } break; } + case ARRAY_VALUES: { + Tcl_HashSearch search; + Var *varPtr2; + char *pattern = NULL; + char *name; + Tcl_Obj *namePtr, *nameListPtr, *valuePtr, **namePtrPtr; + int i, count; + + if (objc<3 || objc>4) { + Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?"); + return TCL_ERROR; + } + if (notArray) { + return TCL_OK; + } + if (objc == 4) { + pattern = Tcl_GetString(objv[3]); + } + + /* + * Allocate an object for our workspace. + */ + + nameListPtr = TclNewObj(); + + /* + * Produce a filtered list of all names to read values for. + */ + + for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + varPtr2 = (Var *) Tcl_GetHashValue(hPtr); + if (TclIsVarUndefined(varPtr2)) { + continue; + } + name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr); + if (pattern != NULL && !Tcl_StringMatch(name, pattern)) { + continue; + } + + namePtr = Tcl_NewStringObj(name, -1); + result = Tcl_ListObjAppendElement(interp, nameListPtr, + namePtr); + if (result != TCL_OK) { + TclDecrRefCount(namePtr); /* free unneeded name obj */ + TclDecrRefCount(nameListPtr); + return result; + } + } + + /* + * Make sure the Var structure of the array is not removed by + * a trace while we're working. + */ + + varPtr->refCount++; + + /* + * Get the array values corresponding to each element name + */ + + tmpResPtr = TclNewObj(); + result = Tcl_ListObjGetElements(interp, nameLstPtr, + &count, &namePtrPtr); + if (result != TCL_OK) { + goto errorInArrayValues; + } + + for (i = 0; i < count; i++) { + namePtr = *namePtrPtr++; + valuePtr = Tcl_ObjGetVar2(interp, objv[2], namePtr, + TCL_LEAVE_ERR_MSG); + if (valuePtr == NULL) { + /* + * Some trace played a trick on us; we need to diagnose to + * adapt our behaviour: was the array element unset, or did + * the modification modify the complete array? + */ + + if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) { + /* + * The array itself looks OK, the variable was + * undefined: forget it. + */ + + continue; + } else { + result = TCL_ERROR; + goto errorInArrayValues; + } + } + result = Tcl_ListObjAppendElement(interp, tmpResPtr, valuePtr); + if (result != TCL_OK) { + goto errorInArrayValues; + } + } + varPtr->refCount--; + Tcl_SetObjResult(interp, tmpResPtr); + TclDecrRefCount(nameLstPtr); + break; + + errorInArrayValues: + varPtr->refCount--; + TclDecrRefCount(nameLstPtr); + TclDecrRefCount(tmpResPtr); /* free unneeded temp result obj */ + return result; + } case ARRAY_NEXTELEMENT: { ArraySearch *searchPtr; Tcl_HashEntry *hPtr; |