Intent to work on "array foreach" (new array ensemble command in C).
Opened this issue · 16 comments
bll123 commented
brad.lanam.comp @ gmail.com
- array for {key value} myarray { script }
Working 2016-11-21
Aborted iteration due to array changes working 2017-5-1 - array for {key} myarray {script}
Working 2016-11-22
Aborted iteration due to array changes working 2017-5-1
This variant has been removed - review code and clean up
Complete - write tests
Done 2017-5-1, including tests for aborted iteration due to array changes - code review
DGP did a code review, cleaned up and added another test 2018-4-19 - TIP
TIP 421 is posted and is being sponsored by Steve Landers (2018-3-6)
TIP 421 accepted and added to the core-8-branch 2018-4-20 - submit patch.
The code is now in branch 'tip-421', based on 8.7. 2018-3-6
bovine commented
A previously existing TIP was opened by karl years ago but never finished. The template might be reusable as the basis for this new TIP. http://www.tcl.tk/cgi-bin/tct/tip/421.html
bll123 commented
Yes, thanks. I am going to ask whether that TIP should be updated or create a new TIP.
bovine commented
Please note that the primary motivation of this enhancement is not just a syntactic improvement, but an actual performance improvement by eliminating the need to duplicate the array with [array get]
Providing benchmarks that support the efficiency of your implementation over the traditional commands required today would provide additional rationale for the TIP to be accepted.
bll123 commented
Correct. My implementation does not create a new list.
And I will think on how to build and perform a benchmark for this.
bll123 commented
Memory footprint:
foreach/array get 32k: virt: 46680 res: 16740 shr: 4564
array for 32k : virt: 41504 res: 12024 shr: 4640
foreach/array get 100k: virt: 70684 res: 40624 shr: 4400
array for 100k : virt: 59852 res: 29880 shr: 4392
memory savings are significant.
testing runtime speed is a problem, as there is no bytecode compilation for 'array for'.
If I turn off bytecode compilation for both 'foreach' and 'array get', I get (most of these are only 100 iterations):
foreach/array get 32k: 39790 micro-s
array for 32k: 28030 micro-s
foreach/array get 100k: 123212
array for 100k : 107200
foreach/array get 300k: 374503
array for 300k : 266932
foreach/array get 500k: 623999
array for 500k : 441894
foreach/array get 1000k: 1273508
array for 1000k : 875817
dkfellows commented
The code is on a development branch at http://core.tcl.tk/tcl/timeline?r=lanam-array-for-impl
While I've added a bit to the code, I don't consider my changes to be anything other than normal Tcl maintainer work, i.e., not eligible for the bounty. Also, being on a development branch on core is not a satisfaction of the bounty conditions. (If nothing else, there's also a need for documentation and for the code to not crash when there's an unexpected purge of the iterator…)
bll123 commented
'array for' is working.
- array changed during iteration generates error
- tests added for array change during iteration
- man page update
- it is not merged with Andy Goth's changes at this time.
Benchmark with 100000 entries in the array
foreach/array get :
Memory: Virtual: 71556 Resident: 41084 Shared: 4116
time: 30289.236
array for: (**not bytecoded**)
Memory: Virtual: 55132 Resident: 25580 Shared: 4088
Time: 31331.647
I would attach the code, but unfortunately I have checked it into my local fossil repo, and I have no idea how to get a proper diff out (it displays changes that are part of some prior check-in). I can always reapply the changes to a known base again -- it's not that much code.
Needed: TIP changes, Code review.
resuna commented
Is that right, a loop using foreach/array get uses more memory but is faster than array for?
bll123 commented
It is not bytecoded like foreach is.
This comparison is a bytecoded foreach against the non-bytecoded array for.
bll123 commented
Some brainstorming discussion in:
http://tclers.tk/conferences/tcl/2017%2d10%2d24.tcl
(This link will die in a month).
My to-do, I will have this done before 2017-11-1.
Implementation of 'array for', the iteration raises an error upon modification of the array.
- Fix the one bug where the trace fires twice on the first item.
- Put together the diff and ship it to someone to put into fossil.
The remaining items are separate tasks and need more discussion.
Someone else may take these on:
Insertions:
'array for' would simply skip over new insertions.
Two possibilities:
a) Have a global epoch timestamp,
Each insertion would increment the epoch timestamp
and mark the new data with the new epoch timestamp.
'array for' can then skip the new insertions easily.
(It seems that a global epoch timestamp would also be useful for updates and deletions,
so this may be the better way to move forward).
b) Have 'array' preserve insertion order like 'dict' does.
When 'array for' starts, it can save the last index.
Any insertion after the last index is skipped.
Deletions:
These are harder.
If an 'array for' is in progress, any deletions would be saved, and 'array for'
would need to iterate over these.
Updates:
If an 'array for' is in progress, the old data would need to be saved.
The global epoch timestamp can be incremented and the updated data
marked with the new epoch timestamp. This will cause 'array for' to skip over the
updated data.
'array for' would then process the saved data just as it would for deletions.
For updates and deletions, have to figure out when the saved items can be
removed. Is it possible for more than one array for to be active on the same
array?
resuna commented
Going full transactional with WAL-like behavior so that updates (not inserts or deletes) are hidden from the iterator is absolutely not a requirement. :)
bll123 commented
Ok, won't let me attach the file, but here is the code so that it will not get lost.
Index: doc/array.n
==================================================================
--- doc/array.n
+++ doc/array.n
@@ -44,10 +44,17 @@
\fBarray startsearch\fR. Returns an empty string.
.TP
\fBarray exists \fIarrayName\fR
Returns 1 if \fIarrayName\fR is an array variable, 0 if there
is no variable by that name or if it is a scalar variable.
+.TP
+\fBarray for {\fIkeyVariable ?valueVariable?\fB} \fIarrayName body\fR
+The first argument is a one or two element list of variable names for the
+key and value of each entry in the array. The second argument is the
+array name to iterate over. The third argument is the body to execute
+for each key and value returned.
+The ordering of the returned keys is undefined.
.TP
\fBarray get \fIarrayName\fR ?\fIpattern\fR?
Returns a list containing pairs of elements. The first
element in each pair is the name of an element in \fIarrayName\fR
and the second element of each pair is the value of the
Index: generic/tclVar.c
==================================================================
--- generic/tclVar.c
+++ generic/tclVar.c
@@ -163,18 +163,21 @@
* Tcl_NextHashEntry to get value to
* return. */
struct ArraySearch *nextPtr;/* Next in list of all active searches for
* this variable, or NULL if this is the last
* one. */
+ Tcl_Obj *arrayNameObj; /* name of the array object */
} ArraySearch;
/*
* Forward references to functions defined later in this file:
*/
static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Obj *patternPtr, int includeLinks);
+static void ArrayDoneSearch (Interp *iPtr, Var *varPtr, ArraySearch *searchPtr);
+static Tcl_NRPostProc ArrayForLoopCallback;
static void DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
static void DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
Var *varPtr, int flags, int index);
static Tcl_Var ObjFindNamespaceVar(Tcl_Interp *interp,
Tcl_Obj *namePtr, Tcl_Namespace *contextNsPtr,
@@ -3096,10 +3099,325 @@
}
/*
*----------------------------------------------------------------------
*
+ * ArrayForNRCmd
+ * ArrayForLoopCallback
+ * ArrayObjFirst
+ * ArrayObjNext
+ *
+ * These functions implement the "array for" Tcl command.
+ * array for {k v} a {}
+ * The array for command iterates over the array, setting the
+ * the specified loop variables, and executing the body each iteration.
+ *
+ * ArrayForNRCmd() sets up the ArraySearch structure, sets arrayNamePtr
+ * inside the structure and calls VarHashFirstEntry to start the hash
+ * iteration.
+ *
+ * ArrayForNRCmd() does not execute the body or set the loop variables,
+ * it only initializes the iterator.
+ *
+ * ArrayForLoopCallback() iterates over the entire array, executing
+ * the body each time.
+ *
+ * ArrayObjFirst() Does not execute the body or set the key/value variables.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+ArrayObjFirst(
+ Tcl_Interp *interp,
+ Tcl_Obj *arrayNameObj,
+ Var *varPtr,
+ ArraySearch *searchPtr)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_HashEntry *hPtr;
+ int isNew;
+
+ searchPtr->varPtr = varPtr;
+ searchPtr->arrayNameObj = arrayNameObj;
+
+ /* add the search to the search table */
+ hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
+ if (isNew) {
+ searchPtr->id = 1;
+ varPtr->flags |= VAR_SEARCH_ACTIVE;
+ searchPtr->nextPtr = NULL;
+ } else {
+ searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
+ searchPtr->nextPtr = Tcl_GetHashValue(hPtr);
+ }
+ searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
+ &searchPtr->search);
+ Tcl_SetHashValue(hPtr, searchPtr);
+}
+
+int
+ArrayObjNext(
+ Tcl_Interp *interp,
+ Var *varPtr, /* array */
+ ArraySearch *searchPtr,
+ Tcl_Obj **keyPtrPtr, /* Pointer to a variable to have the key
+ * written into, or NULL. */
+ Tcl_Obj **valuePtrPtr /* Pointer to a variable to have the
+ * value written into, or NULL.*/
+ )
+{
+ Tcl_Obj *keyObj;
+ Tcl_Obj *valueObj = NULL;
+ int gotValue;
+ int donerc;
+
+ donerc = TCL_BREAK;
+
+ if ((varPtr->flags & VAR_SEARCH_ACTIVE) != VAR_SEARCH_ACTIVE) {
+ donerc = TCL_ERROR;
+ return donerc;
+ }
+
+ gotValue = 0;
+ while (1) {
+ Tcl_HashEntry *hPtr = searchPtr->nextEntry;
+ if (hPtr != NULL) {
+ searchPtr->nextEntry = NULL;
+ } else {
+ hPtr = Tcl_NextHashEntry(&searchPtr->search);
+ if (hPtr == NULL) {
+ gotValue = 0;
+ break;
+ }
+ }
+ varPtr = VarHashGetValue(hPtr);
+ if (!TclIsVarUndefined(varPtr)) {
+ gotValue = 1;
+ break;
+ }
+ }
+
+ if (! gotValue) {
+ return donerc;
+ }
+
+ donerc = TCL_CONTINUE;
+
+ keyObj = VarHashGetKey(varPtr);
+ *keyPtrPtr = keyObj;
+ valueObj = Tcl_ObjGetVar2(interp, searchPtr->arrayNameObj,
+ keyObj, TCL_LEAVE_ERR_MSG);
+ *valuePtrPtr = valueObj;
+
+ return donerc;
+}
+
+static int
+ArrayForNRCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
+ Tcl_Obj **varv;
+ Tcl_Obj *arrayNameObj;
+ ArraySearch *searchPtr = NULL;
+ Var *varPtr;
+ Var *arrayPtr;
+ int varc;
+
+ /*
+ * array for {k v} a body
+ */
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "{key value} arrayName script");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse arguments.
+ */
+
+ if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (varc != 2) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "must have two variable names", -1));
+ Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "array", "for", NULL);
+ return TCL_ERROR;
+ }
+
+ arrayNameObj = objv[2];
+ keyVarObj = varv[0];
+ valueVarObj = varv[1];
+ scriptObj = objv[3];
+
+ /*
+ * Locate the array variable.
+ */
+
+ varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ 0,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+
+ /*
+ * Special array trace used to keep the env array in sync for array names,
+ * array get, etc.
+ */
+
+ if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
+ && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+ if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, arrayNameObj, NULL,
+ (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
+ TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Verify that it is indeed an array variable. This test comes after the
+ * traces; the variable may actually become an array as an effect of said
+ * traces.
+ */
+
+ if ((varPtr == NULL) || !TclIsVarArray(varPtr)
+ || TclIsVarUndefined(varPtr)) {
+ const char *varName = Tcl_GetString(arrayNameObj);
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't an array", varName));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", varName, NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make a new array search, put it on the stack.
+ */
+
+ searchPtr = ckalloc(sizeof(ArraySearch));
+ searchPtr->arrayNameObj = NULL;
+ ArrayObjFirst(interp, arrayNameObj, varPtr, searchPtr);
+
+ /*
+ * Make sure that these objects (which we need throughout the body of the
+ * loop) don't vanish.
+ */
+
+ Tcl_IncrRefCount(keyVarObj);
+ Tcl_IncrRefCount(valueVarObj);
+ Tcl_IncrRefCount(scriptObj);
+
+ /*
+ * Run the script.
+ */
+
+ TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, keyVarObj,
+ valueVarObj, scriptObj);
+ return TCL_OK;
+}
+
+static int
+ArrayForLoopCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ ArraySearch *searchPtr = data[0];
+ Tcl_Obj *keyVarObj = data[1];
+ Tcl_Obj *valueVarObj = data[2];
+ Tcl_Obj *scriptObj = data[3];
+ Tcl_Obj *keyObj, *valueObj;
+ Var *varPtr;
+ Var *arrayPtr;
+ int done;
+
+ /*
+ * Process the result from the previous execution of the script body.
+ */
+
+ done = TCL_ERROR;
+ varPtr = TclObjLookupVarEx(interp, searchPtr->arrayNameObj, NULL, /*flags*/ 0,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+
+ if (result == TCL_CONTINUE) {
+ result = TCL_OK;
+ } else if (result != TCL_OK) {
+ if (result == TCL_BREAK) {
+ Tcl_ResetResult(interp);
+ result = TCL_OK;
+ } else if (result == TCL_ERROR) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"array for\" body line %d)",
+ Tcl_GetErrorLine(interp)));
+ }
+ goto arrayfordone;
+ }
+
+ /*
+ * Get the next mapping from the array.
+ */
+
+ keyObj = NULL;
+ valueObj = NULL;
+ done = ArrayObjNext (interp, varPtr, searchPtr, &keyObj, &valueObj);
+
+ result = TCL_OK;
+ if (done != TCL_CONTINUE) {
+ Tcl_ResetResult(interp);
+ if (done == TCL_ERROR) {
+ varPtr->flags |= TCL_LEAVE_ERR_MSG;
+ Tcl_AddErrorInfo(interp, "array changed during iteration");
+ result = done;
+ }
+ goto arrayfordone;
+ }
+ if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ goto arrayfordone;
+ }
+ if (valueObj != NULL) {
+ if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ goto arrayfordone;
+ }
+ }
+
+ /*
+ * Run the script.
+ */
+
+ TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, keyVarObj,
+ valueVarObj, scriptObj);
+ return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
+
+ /*
+ * For unwinding everything once the iterating is done.
+ */
+
+ arrayfordone:
+ /* if the search was terminated by an array change, the
+ * VAR_SEARCH_ACTIVE flag will no longer be set
+ */
+ if (done != TCL_ERROR) {
+ ArrayDoneSearch (iPtr, varPtr, searchPtr);
+ ckfree(searchPtr);
+ }
+
+ TclDecrRefCount(keyVarObj);
+ TclDecrRefCount(valueVarObj);
+ TclDecrRefCount(scriptObj);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ArrayStartSearchCmd --
*
* This object-based function is invoked to process the "array
* startsearch" Tcl command. See the user documentation for details on
* what it does.
@@ -3191,10 +3509,54 @@
Tcl_SetHashValue(hPtr, searchPtr);
Tcl_SetObjResult(interp,
Tcl_ObjPrintf("s-%d-%s", searchPtr->id, varName));
return TCL_OK;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayDoneSearch --
+ *
+ * Removes the search from the hash of active searches.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ArrayDoneSearch (
+ Interp *iPtr,
+ Var *varPtr,
+ ArraySearch *searchPtr)
+{
+ Tcl_HashEntry *hPtr;
+ ArraySearch *prevPtr;
+
+ /*
+ * Unhook the search from the list of searches associated with the
+ * variable.
+ */
+
+ hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
+ if (hPtr == NULL) {
+ return;
+ }
+ if (searchPtr == Tcl_GetHashValue(hPtr)) {
+ if (searchPtr->nextPtr) {
+ Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
+ } else {
+ varPtr->flags &= ~VAR_SEARCH_ACTIVE;
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ } else {
+ for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
+ if (prevPtr->nextPtr == searchPtr) {
+ prevPtr->nextPtr = searchPtr->nextPtr;
+ break;
+ }
+ }
+ }
+}
/*
*----------------------------------------------------------------------
*
* ArrayAnyMoreCmd --
@@ -3435,13 +3797,12 @@
int objc,
Tcl_Obj *const objv[])
{
Interp *iPtr = (Interp *) interp;
Var *varPtr, *arrayPtr;
- Tcl_HashEntry *hPtr;
Tcl_Obj *varNameObj, *searchObj;
- ArraySearch *searchPtr, *prevPtr;
+ ArraySearch *searchPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
return TCL_ERROR;
}
@@ -3491,31 +3852,11 @@
searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
if (searchPtr == NULL) {
return TCL_ERROR;
}
- /*
- * Unhook the search from the list of searches associated with the
- * variable.
- */
-
- hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
- if (searchPtr == Tcl_GetHashValue(hPtr)) {
- if (searchPtr->nextPtr) {
- Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
- } else {
- varPtr->flags &= ~VAR_SEARCH_ACTIVE;
- Tcl_DeleteHashEntry(hPtr);
- }
- } else {
- for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
- if (prevPtr->nextPtr == searchPtr) {
- prevPtr->nextPtr = searchPtr->nextPtr;
- break;
- }
- }
- }
+ ArrayDoneSearch (iPtr, varPtr, searchPtr);
ckfree(searchPtr);
return TCL_OK;
}
/*
@@ -4370,10 +4711,11 @@
{
static const EnsembleImplMap arrayImplMap[] = {
{"anymore", ArrayAnyMoreCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"donesearch", ArrayDoneSearchCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"exists", ArrayExistsCmd, TclCompileArrayExistsCmd, NULL, NULL, 0},
+ {"for", NULL, TclCompileBasic3ArgCmd, ArrayForNRCmd, NULL, 0},
{"get", ArrayGetCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{"names", ArrayNamesCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
{"nextelement", ArrayNextElementCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"set", ArraySetCmd, TclCompileArraySetCmd, NULL, NULL, 0},
{"size", ArraySizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
Index: tests/set-old.test
==================================================================
--- tests/set-old.test
+++ tests/set-old.test
@@ -338,11 +338,11 @@
} {1 {"x" isn't an array}}
test set-old-8.6 {array command} {
catch {unset a}
set a(22) 3
list [catch {array gorp a} msg] $msg
-} {1 {unknown or ambiguous subcommand "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, statistics, or unset}}
+} {1 {unknown or ambiguous subcommand "gorp": must be anymore, donesearch, exists, for, get, names, nextelement, set, size, startsearch, statistics, or unset}}
test set-old-8.7 {array command, anymore option} {
catch {unset a}
list [catch {array anymore a x} msg] $msg
} {1 {"a" isn't an array}}
test set-old-8.8 {array command, anymore option, array doesn't exist yet but has compiler-allocated procedure slot} {
@@ -931,10 +931,10 @@
catch {unset aVaRnAmE}
catch {rename foo {}}
# cleanup
::tcltest::cleanupTests
-return
+return
# Local Variables:
# mode: tcl
# End:
Index: tests/var.test
==================================================================
--- tests/var.test
+++ tests/var.test
@@ -51,11 +51,11 @@
catch {unset arr}
test var-1.1 {TclLookupVar, Array handling} -setup {
catch {unset a}
} -body {
- set x "incr" ;# force no compilation and runtime call to Tcl_IncrCmd
+ set x "incr" ;# force no compilation and runtime call to Tcl_IncrCmd
set i 10
set arr(foo) 37
list [$x i] $i [$x arr(foo)] $arr(foo)
} -result {11 11 38 38}
set ::x "global value"
@@ -232,11 +232,11 @@
catch {unset a}
} -constraints testupvar -body {
set a 123321
proc p {} {
# create global xx linked to global a
- testupvar 1 a {} xx global
+ testupvar 1 a {} xx global
}
list [p] $xx [set xx 789] $a
} -result {{} 123321 789 789}
test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} -setup {
catch {unset a}
@@ -244,11 +244,11 @@
set a 456
namespace eval test_ns_var {
catch {unset ::test_ns_var::vv}
proc p {} {
# create namespace var vv linked to global a
- testupvar 1 a {} vv namespace
+ testupvar 1 a {} vv namespace
}
p
}
list $test_ns_var::vv [set test_ns_var::vv 123] $a
} -result {456 123 123}
@@ -546,15 +546,15 @@
} {{My name is ":"} :}
test var-7.14 {Tcl_VariableObjCmd, array element parameter} -body {
namespace eval test_ns_var { variable arrayvar(1) }
} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
test var-7.15 {Tcl_VariableObjCmd, array element parameter} -body {
- namespace eval test_ns_var {
+ namespace eval test_ns_var {
variable arrayvar
set arrayvar(1) x
variable arrayvar(1) y
- }
+ }
} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
test var-7.16 {Tcl_VariableObjCmd, no args (TIP 323)} {
variable
} {}
test var-7.17 {Tcl_VariableObjCmd, no args (TIP 323)} {
@@ -788,11 +788,11 @@
proc A { name } {
upvar $name var
set var $name
}
#
- # Note that the variable name has to be
+ # Note that the variable name has to be
# unused previously for the segfault to
# be triggered.
#
namespace eval test A useSomeUnlikelyNameHere
namespace eval test unset useSomeUnlikelyNameHere
@@ -995,11 +995,157 @@
} -cleanup {
array unset A
rename getbytes {}
rename doit {}
} -result 0
-
+
+unset -nocomplain a k v
+test var-23.1 {array command, for loop, too many args} -returnCodes error -body {
+ array for {k v} c d e {}
+} -result {wrong # args: should be "array for {key value} arrayName script"}
+test var-23.2 {array command, for loop, not enough args} -returnCodes error -body {
+ array for {k v} {}
+} -result {wrong # args: should be "array for {key value} arrayName script"}
+test var-23.3 {array command, for loop, too many list args} -setup {
+ unset -nocomplain a
+} -returnCodes error -body {
+ array for {k v w} a {}
+} -result {must have two variable names}
+test var-23.4 {array command, for loop, not enough list args} -setup {
+ unset -nocomplain a
+} -returnCodes error -body {
+ array for {k} a {}
+} -result {must have two variable names}
+test var-23.5 {array command, for loop, no array} -setup {
+ unset -nocomplain a
+} -returnCodes error -body {
+ array for {k v} a {}
+} -result {"a" isn't an array}
+test var-23.6 {array command, for loop, array doesn't exist yet but has compiler-allocated procedure slot} -setup {
+ catch {rename p ""}
+} -returnCodes error -body {
+ apply {{x} {
+ if {$x==1} {
+ return [array for {k v} a {}]
+ }
+ set a(x) 123
+ }} 1
+} -result {"a" isn't an array}
+test var-23.7 {array enumeration} -setup {
+ unset -nocomplain a
+ set reslist [list]
+} -body {
+ array set a {a 1 b 2 c 3}
+ array for {k v} a {
+ lappend reslist $k $v
+ }
+ lsort -stride 2 -index 0 $reslist
+} -cleanup {
+ unset -nocomplain a
+ unset -nocomplain reslist
+} -result {a 1 b 2 c 3}
+test var-23.9 {array enumeration, nested} -setup {
+ unset -nocomplain a
+ set reslist [list]
+} -body {
+ array set a {a 1 b 2 c 3}
+ array for {k1 v1} a {
+ lappend reslist $k1 $v1
+ set r2 {}
+ array for {k2 v2} a {
+ lappend r2 $k2 $v2
+ }
+ lappend reslist [lsort -stride 2 -index 0 $r2]
+ }
+ # there is no guarantee in which order the array contents will be
+ # returned.
+ lsort -stride 3 -index 0 $reslist
+} -cleanup {
+ unset -nocomplain a
+ unset -nocomplain reslist
+} -result {a 1 {a 1 b 2 c 3} b 2 {a 1 b 2 c 3} c 3 {a 1 b 2 c 3}}
+test var-23.10 {array enumeration, delete key} -match glob -setup {
+ unset -nocomplain a
+ set reslist [list]
+} -body {
+ set retval {}
+ try {
+ array set a {a 1 b 2 c 3 d 4}
+ array for {k v} a {
+ lappend reslist $k $v
+ if { $k eq "a" } {
+ unset a(c)
+ }
+ }
+ lsort -stride 2 -index 0 $reslist
+ } on error {err res} {
+ set retval [dict get $res -errorinfo]
+ }
+ set retval
+} -cleanup {
+ unset -nocomplain a
+ unset -nocomplain reslist
+ unset -nocomplain retval
+} -result {array changed during iteration*}
+test var-23.11 {array enumeration, insert key} -match glob -setup {
+ unset -nocomplain a
+ set reslist [list]
+} -body {
+ set retval {}
+ try {
+ array set a {a 1 b 2 c 3 d 4}
+ array for {k v} a {
+ lappend reslist $k $v
+ if { $k eq "a" } {
+ set a(e) 5
+ }
+ }
+ lsort -stride 2 -index 0 $reslist
+ } on error {err res} {
+ set retval [dict get $res -errorinfo]
+ }
+} -cleanup {
+ unset -nocomplain a
+ unset -nocomplain reslist
+} -result {array changed during iteration*}
+test var-23.12 {array enumeration, change value} -setup {
+ unset -nocomplain a
+ set reslist [list]
+} -body {
+ array set a {a 1 b 2 c 3}
+ array for {k v} a {
+ lappend reslist $k $v
+ if { $k eq "a" } {
+ set a(c) 9
+ }
+ }
+ lsort -stride 2 -index 0 $reslist
+} -cleanup {
+ unset -nocomplain a
+ unset -nocomplain reslist
+} -result {a 1 b 2 c 9}
+test var-23.13 {array enumeration, number of traces} -setup {
+ set ::countarrayfor 0
+ proc ::tracearrayfor { args } {
+ incr ::countarrayfor
+ }
+ unset -nocomplain ::a
+ set reslist [list]
+} -body {
+ array set ::a {a 1 b 2 c 3}
+ foreach {k} [array names a] {
+ trace add variable ::a($k) read ::tracearrayfor
+ }
+ array for {k v} ::a {
+ lappend reslist $k $v
+ }
+ set ::countarrayfor
+} -cleanup {
+ unset -nocomplain ::countarrayfor
+ unset -nocomplain ::a
+ unset -nocomplain reslist
+} -result 3
catch {namespace delete ns}
catch {unset arr}
catch {unset v}
bll123 commented
The code has been commited to branch: bll-array-for, and the TIP is updated.
Many thanks to fvogel for the fossil updates.
bll123 commented
The code is now in branch tip-421, based on 8.7. There is a TIP, Steve Landers is sponsoring the TIP, and there is a discussion started in the tcl-core mailing list.
bll123 commented
TIP 421 has been accepted and is now in the core-8-branch and will be present in the next alpha release of 8.7.
The implementation is just a wrapper around array startsearch/next/donesearch, as most people want the
failure conditions when the array changes. It has no speed improvements, but the memory footprint is
much smaller.