summaryrefslogtreecommitdiffstats
path: root/generic/tclVar.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclVar.c')
-rw-r--r--generic/tclVar.c130
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;