Attachment "arrayValues.diff" to
ticket [985647ffff]
added by
dkf
2004-07-06 22:17:30.
Index: generic/tclVar.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclVar.c,v
retrieving revision 1.86
diff -u -r1.86 tclVar.c
--- generic/tclVar.c 27 May 2004 20:44:37 -0000 1.86
+++ generic/tclVar.c 6 Jul 2004 15:15:48 -0000
@@ -2673,10 +2673,11 @@
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;
@@ -2983,6 +2984,114 @@
}
break;
}
+ case ARRAY_VALUES: {
+ Tcl_HashSearch search;
+ Var *varPtr2;
+ char *pattern = NULL;
+ char *name;
+ Tcl_Obj *namePtr, *nameListPtr, *valuePtr, *tmpResPtr;
+ Tcl_Obj **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.
+ */
+
+ TclNewObj(nameListPtr);
+
+ /*
+ * 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
+ */
+
+ TclNewObj(tmpResPtr);
+ result = Tcl_ListObjGetElements(interp, nameListPtr,
+ &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(nameListPtr);
+ break;
+
+ errorInArrayValues:
+ varPtr->refCount--;
+ TclDecrRefCount(nameListPtr);
+ TclDecrRefCount(tmpResPtr); /* free unneeded temp result obj */
+ return result;
+ }
case ARRAY_NEXTELEMENT: {
ArraySearch *searchPtr;
Tcl_HashEntry *hPtr;
